VBA在命令按钮上显示/隐藏图像或形状单击事件对数据进行排序答案

【问题标题】：VBA Show / Hide Images or Shapes on Command Button Click Event To Sort DataVBA在命令按钮上显示/隐藏图像或形状单击事件对数据进行排序
【发布时间】：2020-07-03 17:33:50
【问题描述】：

我正在开发一个程序，该程序具有多列数据，可以按几列排序。为了美观，我使用命令按钮单击事件来切换升序或降序排序。我的代码很简单。我使用“向上”箭头和“向下”箭头的图像作为升/降指示符。所有图像都在工作表上，并且根据排序方法，单击事件会显示或隐藏相应的图像。编码正在正确处理一个我没有考虑过的问题。当用户单击按钮进行排序时，该箭头会正确显示和隐藏该列，但其他列仍显示可能使用户感到困惑的箭头。我想隐藏除正在排序的列中的图像/箭头之外的其他图像/箭头。

请参阅附件图片以获取说明

在上图中，如果再次按下 Player ID 命令按钮，向上箭头将隐藏，向下箭头将可见，但其他箭头将保持原样。我只希望被排序的列显示箭头。

以下代码在工作表模块中使用命令按钮单击事件。

Private Sub cmbAgentID_Click()

    If ActiveSheet.Shapes.Range(Array("picAgentIDUp")).Visible = False Then
        Call SortByAgentAsc 'sort ascending
        ActiveSheet.Shapes.Range(Array("picAgentIDUp")).Visible = True
        ActiveSheet.Shapes.Range(Array("picAgentIDDown")).Visible = False
    Else
        Call SortByAgentDes 'sort descending
        ActiveSheet.Shapes.Range(Array("picAgentIDDown")).Visible = True
        ActiveSheet.Shapes.Range(Array("picAgentIDUp")).Visible = False
    End If
End Sub
Private Sub cmbAllHands_Click()
    
    If ActiveSheet.Shapes.Range(Array("picAllHandsUp")).Visible = False Then
        Call SortByHandsAsc 'sort ascending
        ActiveSheet.Shapes.Range(Array("picAllHandsUp")).Visible = True
        ActiveSheet.Shapes.Range(Array("picAllHandsDown")).Visible = False
    Else
        Call SortByHandsDes 'sort descending
        ActiveSheet.Shapes.Range(Array("picAllHandsDown")).Visible = True
        ActiveSheet.Shapes.Range(Array("picAllHandsUp")).Visible = False
    End If
        
End Sub
Private Sub cmbCashHands_Click()

    
    If ActiveSheet.Shapes.Range(Array("picCashUp")).Visible = False Then
        Call SortByCashAsc 'sort ascending
        ActiveSheet.Shapes.Range(Array("picCashUp")).Visible = True
        ActiveSheet.Shapes.Range(Array("picCashDown")).Visible = False
    Else
        Call SortByCashDes 'sort descending
        ActiveSheet.Shapes.Range(Array("picCashDown")).Visible = True
        ActiveSheet.Shapes.Range(Array("picCashUp")).Visible = False
    End If
        
End Sub
Private Sub cmbEmbers_Click()
    
    If ActiveSheet.Shapes.Range(Array("picEmbersUp")).Visible = False Then
        Call SortByEmbersAsc 'sort ascending
        ActiveSheet.Shapes.Range(Array("picEmbersUp")).Visible = True
        ActiveSheet.Shapes.Range(Array("picEmbersDown")).Visible = False
    Else
        Call SortByEmbersDes 'sort descending
        ActiveSheet.Shapes.Range(Array("picEmbersDown")).Visible = True
        ActiveSheet.Shapes.Range(Array("picEmbersUp")).Visible = False
    End If
    
End Sub
Private Sub cmbFees_Click()
            
    If ActiveSheet.Shapes.Range(Array("picFeeUp")).Visible = False Then
        Call SortByFeeAsc 'sort ascending
        ActiveSheet.Shapes.Range(Array("picFeeUp")).Visible = True
        ActiveSheet.Shapes.Range(Array("picFeeDown")).Visible = False
    Else
        Call SortByFeeDes 'sort descending
        ActiveSheet.Shapes.Range(Array("picFeeDown")).Visible = True
        ActiveSheet.Shapes.Range(Array("picFeeUp")).Visible = False
    End If
        
End Sub

有什么建议吗？我一直在寻找对我来说是新的 ShapeRange 和 Shape Arrays，但还没有找到我想要的东西。

-------更新了以下代码，建议的改进不起作用-------

创建“旋转它”子并将宏分配给单个箭头。

Sub RotateIt()
  
Dim s As Shape: Set s = ActiveSheet.Shapes(Application.Caller)
    
    If s.Rotation = 0 Then
        s.Rotation = 180
    Else
        s.Rotation = 0
    End If
    
End Sub

为排序创建了 1 个子，我认为我的问题在这里......

Sub SortByEverything(sortKey As Range, Optional boolAsc As Boolean)
  
  Dim sh As Worksheet: Set sh = ActiveSheet
  Dim lastrow As Long: lastrow = Cells(Rows.Count, 2).End(xlUp).Row
  Dim rng As Range: Set rng = sh.Range("B3:M" & lastrow)
  
    If boolAsc Then
        With rng 'your existing code for ACENDING sorting type, but using supplied sortKey...
            .Sort Key1:=sortKey, Order1:=xlAscending, Header:=xlYes
        End With
        Debug.Print "Sort Ascending..."
    Else
        With rng 'your existing code for ACENDING sorting type, but using supplied sortKey...
            .Sort Key1:=sortKey, Order1:=xlAscending, Header:=xlYes
        End With
        Debug.Print "Sort Descending..."
    End If
    
End Sub

创建的类模块按钮名称

Option Explicit

Public WithEvents cmdButton As MSForms.CommandButton

Public Sub cmdButton_Click()

Dim sArr As Shape: Set sArr = ActiveSheet.Shapes("Arrow")

sArr.Top = cmdButton.Top: sArr.Left = cmdButton.Left + cmdButton.Width
    If sArr.Rotation = 0 Then
        SortByEverything cmdButton.TopLeftCell, True
        sArr.Rotation = 180
    Else
        SortByEverything cmdButton.TopLeftCell
        sArr.Rotation = 0
    End If
    
End Sub

创建工作表激活子

Option Explicit

Private arrEvents As Collection

Private Sub Worksheet_Activate()

Dim ActXButEvents As ButtonName, shp As Shape
Set arrEvents = New Collection
varSplitCol = 0
varSplitRow = 4
    
    Call EnhancePerformance
    Call FreezeSheetPanes
    
    For Each shp In Me.Shapes
       If shp.Type = msoOLEControlObject Then
           If TypeOf shp.OLEFormat.Object.Object Is MSForms.CommandButton Then
               Set ActXButEvents = New ButtonName
               Set ActXButEvents.cmdButton = shp.OLEFormat.Object.Object
               arrEvents.Add ActXButEvents
           End If
       End If
    Next
    
    Call NormalPerformance
End Sub

【问题讨论】：

当你输入 If 和 Else 时，调用一个隐藏所有箭头的 sub。然后你只需要关心显示应该可见的单个。
我使用下面的代码做到了这一点，但我的 if 语句充当了我的命令按钮的切换，所以我现在的问题是交替我的箭头。如果选择了向下箭头，那么我的点击事件将调用升序宏，它将隐藏向下箭头并显示向上箭头。如果再次单击该按钮，if 语句将看到存在向上箭头，因此它将调用降序宏，并将隐藏向上箭头并显示向下箭头。

标签： excel vba click show-hide shapes

【解决方案1】：

请尝试下一种方法。创建一个Sub 被所有按钮调用Click 事件：

Sub HideArrows(sh As Worksheet)
 Dim s As Shape
    For Each s In sh.Shapes
        If Right(s.Name, 2) = "Up" Or _
            Right(s.Name, 4) = "Down" Then s.Visible = msoFalse
    Next
End Sub

然后以这种方式使用您现有的代码：

Private Sub cmbAgentID_Click() 'proceed in a similar way to all the other click events
  Dim sh As Worksheet: Set sh = ActiveSheet
  
    HideArrows sh
    If sh.Shapes.Range(Array("picAgentIDUp")).Visible = False Then
        Call SortByAgentAsc 'sort ascending
        sh.Shapes.Range(Array("picAgentIDUp")).Visible = True
    Else
        Call SortByAgentDes 'sort descending
        sh.Shapes.Range(Array("picAgentIDDown")).Visible = True
    End If
End Sub

已编辑：请尝试下一个不同的方法。它非常紧凑。 整个必要的代码将是下一个，在一个标准模块中：

创建一个（向上）箭头形状并将其命名为“箭头”
每个（表单类型）按钮将指向相同的Sub，因此为所有按钮分配下一个代码。对于 ActiveX 按钮，我将在最后展示方法（稍微复杂一点，但不要太多）：

    Sub Button_Click()
        Dim s As Shape: Set s = ActiveSheet.Shapes(Application.Caller)
        Dim sArr As Shape: Set sArr = ActiveSheet.Shapes("Arrow")
        
        sArr.Rop = s.top: sArr.left = s.left + s.width
        If sArr.Rotation = 0 Then
            SortByEverything s.TopLeftCell, True 'ascending
            sArr.Rotation = 180
        Else
            SortByEverything s.TopLeftCell       'descending
            sArr.Rotation = 0
        End If
    End Sub

使用下一种方式内置的排序Subs。他们将根据每个按下的按钮位置收到排序键：


    Sub SortByEverything(sortKey As Range, Optional boolAsc As Boolean)
      Dim sh As Worksheet
      Set sh = ActiveSheet
      
      If boolAsc Then
        'your existing code for ACENDING sorting type, but using supplied sortKey...
        '....
        Debug.Print "Sort Ascending..."
      Else
        'your existing code for ACENDING sorting type, but using supplied sortKey...
        '....
        Debug.Print "Sort Descending..."
      End If
    End Sub

要更改箭头方向/排序类型，请将下一个代码分配给“箭头”形状：

    Sub RotateIt()
      Dim s As Shape: Set s = ActiveSheet.Shapes(Application.Caller)
        If s.Rotation = 0 Then
            s.Rotation = 180
        Else
            s.Rotation = 0
        End If
    End Sub

这种方法理念将是下一个：当按下按钮时，“箭头”形状将移动到其右侧。根据其rotation 属性，排序将按升序或降序进行。然后箭头旋转将被调整。如果它仍然是向下的，下一次，对于不同的列，您需要降序排序，只需单击箭头形状，它将旋转到适当的排序类型。您只需要一个排序Sub 是informed 关于排序键和排序类型...

如果是 ActiveX 按钮，Application.Coller 不会返回调用子名称的形状，并且需要类事件包装器...

a) 插入一个类模块，命名为ButtonName 并复制下一段代码：

Option Explicit

Public WithEvents cmdButton As MSForms.CommandButton

Public Sub cmdButton_Click()
    Dim sArr As Shape: Set sArr = ActiveSheet.Shapes("Arrow")
    
    sArr.top = cmdButton.top: sArr.left = cmdButton.left + cmdButton.width
    If sArr.Rotation = 0 Then
        SortByEverything cmdButton.TopLeftCell, True
        sArr.Rotation = 180
    Else
        SortByEverything cmdButton.TopLeftCell
        sArr.Rotation = 0
    End If
End Sub

注意：所有 ActiveX 按钮都不需要点击事件（对于此特定任务）！

b) 在工作表级别模块创建一个私有变量。最重要的是，在声明区域：

     Public arrEvents As Collection

c) 使用Worksheet_Activate 事件（当然是在保留按钮的工作表中），以便为所有 ActiveX 类型的按钮初始化类：

Private Sub Worksheet_Activate()
 Dim ActXButEvents As ButtonName, shp As Shape

 Set arrEvents = New Collection

 For Each shp In Me.Shapes
    If shp.Type = msoOLEControlObject Then
        If TypeOf shp.OLEFormat.Object.Object Is MSForms.CommandButton Then
            Set ActXButEvents = New ButtonName
            Set ActXButEvents.cmdButton = shp.OLEFormat.Object.Object
            arrEvents.aDD ActXButEvents
        End If
    End If
 Next
End Sub

注意：当您拥有代码时，不可能在不触发工作表激活事件的情况下按下工作表上的按钮。但是，在您的代码准备过程中，有必要激活另一个工作表，然后重新激活它。只是为了触发前面提到的事件。

如果有兴趣，请查看，并发送一些反馈。

【讨论】：

这几乎可以工作了。很接近！当我单击命令按钮时，它会隐藏其他按钮并按升序排序 1 次。我认为问题在于，由于我的向上箭头位于向下箭头的顶部，因此当我再次按下命令按钮以切换下降箭头时，它会保持隐藏状态。我的 if 语句说“如果向下箭头可见，则按升序排序并隐藏向下图像并显示向上图像”。如果第一步是隐藏所有图像，那么 if 语句在第一次排序后不会得到我想要的结果。您认为有没有更好的方法来编写 if 语句？
我真的很喜欢你的代码背后的想法。我做错了什么，因为我无法让它工作。你提到的第一个子是 Button_Click，我把那个子去掉了，因为我有 Activexcontrols。我应该把那个潜艇留在里面吗？所以此时我的排序按钮按下但不提供排序并且不更改箭头配置。我的排序代码正确吗？
If boolAsc Then With rng 'your existing code for ACENDING sorting type, but using supplied sortKey... .Sort Key1:=sortKey, Order1:=xlAscending, Header:=xlYes End With Debug.Print "Sort Ascending..." Else With rng 'your existing code for ACENDING sorting type, but using supplied sortKey... .Sort Key1:=sortKey, Order1:=xlAscending, Header:=xlYes End With Debug.Print "Sort Descending..." End If
对不起，我尝试在评论中格式化该代码，我也搞砸了，但希望你能看到它 FaneDuru。
@Adam Rhodes：我无法从您的代码中理解任何内容... 1. Button_Click 对于 ActiveX 按钮毫无用处。 2. 你是否插入了一个类模块，命名为ButtonName 并粘贴了我的代码？ 3. 您是否在有讨论按钮的工作表模块中复制了Worksheet_Activate 事件代码？ 4. 这样做之后，您是否激活了另一张工作表并在其模块中重新激活了包含事件的工作表？

【解决方案2】：

我想通了。感谢 FaneDuru 对我的帮助。我使用了 FaneDuru 提供的编码，但我将向上箭头和向下箭头分开，仍然将它们中的大多数分组，但必须单独隐藏其他箭头。例如在 Player ID 列中。为了让我切换向上和向下箭头，我必须至少有 2 个可用箭头。在 FaneDuru 代码中，它只给我留下了 1 个箭头，因为其余的不可见。我能想到的唯一方法是：

如果在单击事件之前向下箭头可见，那么我可以隐藏除该列中的箭头之外的所有向下箭头和所有向上箭头。当点击事件发生时，向上箭头变为可见而向下箭头隐藏。
工作量更大，因为我必须将其他形状单独放入一个数组中

此问题现已修复，但始终有改进的余地。工作表模块代码

Private Sub cmbAgentID_Click()
    
Dim sh As Worksheet: Set sh = ActiveSheet
            
    If sh.Shapes.Range(Array("picAgentIDUp")).Visible = msoFalse Then
        hidedownarrows sh
        Call SortByAgentAsc 'sort ascending
        With sh.Shapes
            .Range(Array("picAgentIDUp")).Visible = msoTrue
            .Range(Array("picCashUp", "picAllHandsUp", "picEmbersUp", "picRBAmtUp", "PicRBUp", "picFeeUp", "picIDUp")).Visible = msoFalse
        End With
    Else
        HideupArrows sh
        Call SortByAgentDes 'sort descending
        With sh.Shapes
            .Range(Array("picAgentIDDown")).Visible = msoTrue
            .Range(Array("picCashdown", "picAllHandsdown", "picEmbersdown", "picRBAmtdown", "PicRBdown", "picFeedown", "picIDdown")).Visible = msoFalse
        End With
    End If
    
End Sub
Private Sub cmbAllHands_Click()
    
    Dim sh As Worksheet: Set sh = ActiveSheet
    
    If sh.Shapes.Range(Array("picAllHandsUp")).Visible = msoFalse Then
        hidedownarrows sh
        Call SortByHandsAsc 'sort ascending
        With sh.Shapes
            .Range(Array("picAllHandsUp")).Visible = msoTrue
            .Range(Array("picCashUp", "picAgentIDUp", "picEmbersUp", "picRBAmtUp", "PicRBUp", "picFeeUp", "picIDUp")).Visible = msoFalse
        End With
    Else
        HideupArrows sh
        Call SortByHandsDes 'sort descending
        With sh.Shapes
            .Range(Array("picAllHandsDown")).Visible = msoTrue
            .Range(Array("picCashdown", "picAgentIDdown", "picEmbersdown", "picRBAmtdown", "PicRBdown", "picFeedown", "picIDdown")).Visible = msoFalse
        End With
    End If
                
End Sub
Private Sub cmbCashHands_Click()

    Dim sh As Worksheet: Set sh = ActiveSheet
    
    If sh.Shapes.Range(Array("picCashUp")).Visible = msoFalse Then
        hidedownarrows sh
        Call SortByCashAsc 'sort ascending
        With sh.Shapes
            .Range(Array("picCashUp")).Visible = msoTrue
            .Range(Array("picAllHandsUp", "picAgentIDUp", "picEmbersUp", "picRBAmtUp", "PicRBUp", "picFeeUp", "picIDUp")).Visible = msoFalse
        End With
    Else
        HideupArrows sh
        Call SortByCashDes 'sort descending
        With sh.Shapes
            .Range(Array("picCashDown")).Visible = msoTrue
            .Range(Array("picAllHandsDown", "picAgentIDdown", "picEmbersdown", "picRBAmtdown", "PicRBdown", "picFeedown", "picIDdown")).Visible = msoFalse
        End With
        End If
    
End Sub
Private Sub cmbEmbers_Click()
    
    Dim sh As Worksheet: Set sh = ActiveSheet
    
    If sh.Shapes.Range(Array("picEmbersUp")).Visible = msoFalse Then
        hidedownarrows sh
        Call SortByEmbersAsc 'sort ascending
        With sh.Shapes
            .Range(Array("picEmbersUp")).Visible = msoTrue
            .Range(Array("picAllHandsUp", "picAgentIDUp", "picCashUp", "picRBAmtUp", "PicRBUp", "picFeeUp", "picIDUp")).Visible = msoFalse
        End With
    Else
        HideupArrows sh
        Call SortByEmbersDes 'sort descending
        With sh.Shapes
            .Range(Array("picEmbersDown")).Visible = msoTrue
            .Range(Array("picAllHandsDown", "picAgentIDdown", "picCashDown", "picRBAmtdown", "PicRBdown", "picFeedown", "picIDdown")).Visible = msoFalse
        End With
    End If
    
End Sub
Private Sub cmbFees_Click()
            
    Dim sh As Worksheet: Set sh = ActiveSheet

    If sh.Shapes.Range(Array("picFeeUp")).Visible = msoFalse Then
        hidedownarrows sh
        Call SortByFeeAsc 'sort ascending
        With sh.Shapes
            .Range(Array("picFeeUp")).Visible = msoTrue
            .Range(Array("picAllHandsUp", "picAgentIDUp", "picCashUp", "picRBAmtUp", "PicRBUp", "picEmbersUp", "picIDUp")).Visible = msoFalse
        End With
    Else
        HideupArrows sh
        Call SortByFeeDes 'sort descending
        With sh.Shapes
            .Range(Array("picFeeDown")).Visible = msoTrue
            .Range(Array("picAllHandsDown", "picAgentIDdown", "picCashDown", "picRBAmtdown", "PicRBdown", "picEmbersDown", "picIDdown")).Visible = msoFalse
        End With
    End If
        
End Sub

标准模块代码

Sub HideupArrows(sh As Worksheet)

Dim s As Shape

   For Each s In sh.Shapes
       If Right(s.Name, 2) = "Up" Then
           s.Visible = msoFalse
       End If
   Next

End Sub
Sub hidedownarrows(sh As Worksheet)

Dim s As Shape

    For Each s In sh.Shapes
        If Right(s.Name, 4) = "Down" Then
            s.Visible = msoFalse
        End If
    Next
    
End Sub

【讨论】：

很好...投了赞成票。您的按钮是 Form 还是 ActiveX 类型？我可以为您提供一个更紧凑的变体，包括一个箭头，该箭头将移动到按下按钮的右侧并根据之前的排序方式翻转......您还可以在“升序/降序”之间切换点击箭头... 对于表单按钮，由于 Application.Caller 的含义，代码会更简单。所有按钮都将针对相同的 Click sub。如果您想向您展示这种方式，我可以做到...实际上，我会调整我的答案并将其发布为变体。我想你会喜欢的...
我为延迟道歉。我很高兴尝试这个新代码。我今晚要试试，我会回复你的。我只使用 Activex 按钮，因为我可以使用背景颜色将按钮与单元格标题混合，而我无法使用我知道的表单控件来做到这一点。我可以将您的代码与 Shapes 一起使用吗？我可以制作具有相同结果的形状按钮。
我的代码也为 ActiveX 按钮提供了解决方案。该代码也适用于形状。您只需遵循用于Form 形状的过程。我的意思是，您必须为他们分配相同的 Button_Click Sub。没有任何变化。 Application.Caller 返回形状名称，形状对象的获取方式与Form 按钮中的方式完全相同...