时间戳

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

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

问题描述

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

请参阅附件图像以进行说明 例子

在上图中，如果再次按下 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

创建的类模块 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

标签： excelvbaclickshow-hideshapes

解决方案

请尝试下一个方法。创建一个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

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

  1. 创建一个（向上）箭头形状并将其命名为“箭头”

  2. 每个（表单类型）按钮的目标都是相同的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
  1. 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
  1. 为了更改箭头方向/排序类型，请将下一个代码分配给“箭头”形状：
    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关于排序键和排序类型的排序......

  1. 在 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

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

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

推荐阅读