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

Question

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

请参阅附图了解详情

在上图中，如果再次按下播放器 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，但还没有找到我要找的东西。

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

创建了“Rotate It”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

为排序创建了 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

已创建 Class 模块 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

创建工作表激活子

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

Answer 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

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

创建一个（向上）箭头形状并将其命名为“Arrow”
每个（表单类型）按钮将针对相同的 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

为了更改箭头 orientation/sorting 类型，请将下一个代码分配给“箭头”形状：

    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 不会 return 调用子名称的形状，并且需要 Class 事件包装器...

a) 插入一个class模块，命名为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) 在 sheet 级别 模块创建一个私有变量。在它之上，在声明区域：

     Public arrEvents As Collection

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

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

注意：如果您有代码，则无法在不触发 sheet 激活事件的情况下按下正在工作的 sheet 上的按钮。但是，在您的代码准备过程中，有必要激活另一个 sheet 然后重新激活它。就是为了触发前面提到的事件。

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

Answer 2

我明白了。感谢 FaneDuru 帮助我。我使用了 FaneDuru 提供的编码，但我将向上箭头和向下箭头分开，仍然将大部分箭头分组，但必须单独隐藏其他箭头。例如在玩家 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

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

VBA Show / Hide Images or Shapes on Command Button Click Event To Sort Data

excel

vba

click

shapes

show-hide