【问题标题】:If a cells are selected (from more than one sheet) then show message box如果选择了一个单元格(来自多个工作表),则显示消息框
【发布时间】:2017-12-06 16:33:05
【问题描述】:

对于初学者来说,我是自学成才并且仍在学习(我从这个网站学到了很多东西)。话虽如此,请不要假设某些事情是显而易见的。如果您的解决方案过于复杂,我将需要帮助更改代码。

我想要完成的是;如果您在“Sheet3”、“Sheet4”和“Sheet5”上选择单元格 A10,那么我希望显示一个消息框,其中包含来自 Sheets("Sheet6").Range("A1") 的信息。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Count = 1 Then
        If Not Intersect(Target, Range("A10")) Is Nothing Then ' this range is where you click to get the msgbox
                Dim rng As Range, s As String, x As String
                Set rng = Sheets("Sheet6").Range("A1") ' this defines x
                 s = "Define: " ' s is what appears first
                 x = s & rng.Value ' x is what appears after s

                 MsgBox x
        End If
    End If
End Sub

我想发生什么;如果您在“Sheet3”、“Sheet4”和“Sheet5”中并在这三个工作表中的任何一个中选择 A10,它将与代码中定义的消息框一起出现。

什么在起作用;目前这是一个直接在“Sheet5”中的私人子。当它在这里时,如果选择了单元格 A10(在“Sheet5”中),则来自“Sheet6”A1 的信息会根据我的需要出现在消息框中。

什么不工作;因为这是一个私人潜艇并且在“Sheet5”内,所以我正在努力让它与“Sheet3”和“Sheet4”中的 A10 一起使用。

我试图通过移动代码并将其声明为可用于所有工作表的公共子代码来更改代码,但到目前为止没有成功。

【问题讨论】:

    标签: vba excel


    【解决方案1】:

    对于不同的方法,只需在 ThisWorkbook 对象内输入一次。

    Option Explicit
    
    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    
        Select Case Sh.Name
    
            Case Is = "Sheet3", "Sheet4", "Sheet5"
    
                If Target.Address = "$A$10" Then
    
                        MsgBox Worksheets("Sheet6").Range("A1").Value
    
                End If
    
        End Select
    
    End Sub
    

    【讨论】:

      【解决方案2】:

      Worksheet_SelectionChange 必须位于工作表的私有模块中。但是它可以在公共模块中调用另一个例程

      所以如果你把

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
         CheckSelection target
      End Sub
      

      然后,您可以将代码放入三张表中的每张表中的公共模块中

          Public Sub CheckSelection(Target as range)
              etc
      

      【讨论】:

      • 这非常有效。我会尽快接受答案。
      【解决方案3】:

      听起来是个有趣的项目!为了进一步扩展答案,当您使用 Worksheet_SelectionChange 事件时,这是发生在特定对象上的事件。这就是为什么它只适用于背后有代码的一张纸。要在多张纸上完成这项工作,您可以采用以下三种方法之一。

      选项 1:将代码复制到每个工作表对象。从某种意义上说,这是最简单的方法,但在多个位置维护相同代码的副本可能会很麻烦。

      选项 2:将您的代码放在标准模块的公共函数中。这样您就可以在一个位置维护您的代码例程,并使用最少的必要代码从每个工作表中调用它。

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
          MySpecialFunction Target
      End Sub
      

      在大多数情况下,您可能会发现这是处理需求的最有效方式。

      选项 3:另一种更高级的方法是使用包装类对象。这允许您将函数动态应用到任何活动工作表,而无需将(选项 2)代码添加到每个工作表。虽然这更复杂,但它允许您将事件驱动代码应用到任何工作表,甚至是用户创建的新工作表。

      为此,请在您的项目中创建一个类模块,并将其命名为clsMyClass。然后粘贴以下代码:

      Option Explicit
      
      Public WithEvents MySheet As Worksheet
      
      Private Sub MySheet_SelectionChange(ByVal Target As Range)
          ' Do neat stuff here...
      End Sub
      

      这里的关键是WithEvents 声明。这就是允许您从对象变量中利用 事件 的原因。 (但您只能从类对象中执行此操作,而不是标准模块。)

      然后在您的Workbook_Open() 事件中,或您项目中的其他地方,您可以添加将所有当前工作表添加到集合中的函数,允许您为所有这些工作表利用SelectionChange 事件需要为每一个添加代码。

      Option Explicit
      
      Private mcolSheets As Collection
      
      Public Sub ActivateCodeForAllWorksheets()
      
          Dim wks As Worksheet
          Dim cSheet As clsMyClass
      
          ' Initialize module-level collection
          Set mcolSheets = New Collection
      
          For Each wks In ActiveWorkbook.Worksheets
              ' Create new instance of class
              Set cSheet = New clsMyClass
              ' Set to the current worksheet in our loop,
              ' and add to the collection so the sheet object
              ' reference perists after this sub finishes.
              Set cSheet.MySheet = wks
              mcolSheets.Add cSheet
          Next wks
      
      End Sub
      

      在现实生活中,这对于诸如在文本框具有焦点时对其应用特殊格式以及在不需要数百行重复代码的情况下在大量对象中保持这种行为一致等事情非常有用。

      希望对你有帮助!

      【讨论】:

      • 哇,这很有趣。目前这有点超出我的能力,但我只是订购了几本书来扩展我的 VBA 知识,因为我完全不熟悉包装类对象。这次真是万分感谢!我要把它保存到我的桌面以备后用! :)
      猜你喜欢
      • 1970-01-01
      • 2014-09-14
      • 2021-08-26
      • 1970-01-01
      • 2013-12-09
      • 2017-01-30
      • 2012-09-26
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多