excel 工作表中的多个宏取消宏以在列表框中选择和添加多个条目

cbjzeqam  于 12个月前  发布在  其他
关注(0)|答案(1)|浏览(158)

我把下面的宏放在一个工作表中,

  • 列表框中的多个选择
  • 临时导航按钮,用于在选项卡之间来回导航,同时隐藏不必要的选项卡

第一个宏应该允许我在列表框中选择和添加多个条目。当我添加其他宏时,第一个宏停止工作。我只能将一个选择放入列表框。

' To allow multiple selections in a Drop Down List in Excel (without repetition)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Not Intersect(Target, Range("table19")) Is Nothing Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & vbNewLine & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

'<---- Start of Nav Link Cod---->
Private Sub Label1_Click()
End Sub
Private Sub CommandButton1_Click()
Sheets("LIST_locations_LIST").Visible = True
 Sheets("LIST_locations_LIST").Select
End Sub
Private Sub CommandButton2_Click()
Sheets("LIST_Schedule_contact_LIST").Visible = True
 Sheets("LIST_Schedule_contact_LIST").Select
End Sub
Private Sub CommandButton3_Click()
Sheets("LIST_Admin_LIST").Visible = True
 Sheets("LIST_Admin_LIST").Select
End Sub
Private Sub CommandButton4_Click()
Sheets("LIST_System_Owner_LIST").Visible = True
 Sheets("LIST_System_Owner_LIST").Select
End Sub
Private Sub CommandButton5_Click()
Sheets("LIST_Vendor_contacts_LIST").Visible = True
 Sheets("LIST_Vendor_Contacts_LIST").Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
    With ActiveSheet.Shapes("Label1")
        .Top = Target.Offset(1).Top
        .Left = Target.Offset(, 1).Left
    End With
     With ActiveSheet.Shapes("CommandButton1")
        .Top = Target.Offset(3).Top
        .Left = Target.Offset(, 1).Left
    End With
    With ActiveSheet.Shapes("CommandButton2")
        .Top = Target.Offset(5).Top
        .Left = Target.Offset(, 1).Left
    End With
      With ActiveSheet.Shapes("CommandButton3")
        .Top = Target.Offset(7).Top
        .Left = Target.Offset(, 1).Left
    End With
      With ActiveSheet.Shapes("CommandButton4")
        .Top = Target.Offset(9).Top
        .Left = Target.Offset(, 1).Left
    End With
      With ActiveSheet.Shapes("CommandButton5")
        .Top = Target.Offset(11).Top
        .Left = Target.Offset(, 1).Left
    End With
End Sub
'<---- End of Nav Link Cod---->
6jygbczu

6jygbczu1#

代码的问题是两个宏都包含一个ESPRING_Change事件。当用户对工作表进行更改时,这两个宏都会被触发,但它们不能同时运行。这可能会导致不可预测的行为和错误。
若要解决此问题,可以将两个宏合并合并为一个宏,然后删除“选择更改”事件。合并后的宏看起来像这样:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue As String
    Dim Newvalue As String
    Application.EnableEvents = True
    On Error GoTo Exitsub
    
    ' Allow multiple selections in a Drop Down List in Excel (without repetition)
    If Not Intersect(Target, Range("table19")) Is Nothing Then
        If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
            GoTo Exitsub
        Else: If Target.Value = "" Then GoTo Exitsub Else
            Application.EnableEvents = False
            Newvalue = Target.Value
            Application.Undo
            Oldvalue = Target.Value
            If Oldvalue = "" Then
                Target.Value = Newvalue
            Else
                If InStr(1, Oldvalue, Newvalue) = 0 Then
                    Target.Value = Oldvalue & vbNewLine & Newvalue
                Else:
                    Target.Value = Oldvalue
                End If
            End If
        End If
    End If
    
    ' Navigation buttons
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        On Error Resume Next
        With ActiveSheet.Shapes("Label1")
            .Top = Target.Offset(1).Top
            .Left = Target.Offset(, 1).Left
        End With
        With ActiveSheet.Shapes("CommandButton1")
            .Top = Target.Offset(3).Top
            .Left = Target.Offset(, 1).Left
        End With
        With ActiveSheet.Shapes("CommandButton2")
            .Top = Target.Offset(5).Top
            .Left = Target.Offset(, 1).Left
        End With
        With ActiveSheet.Shapes("CommandButton3")
            .Top = Target.Offset(7).Top
            .Left = Target.Offset(, 1).Left
        End With
        With ActiveSheet.Shapes("CommandButton4")
            .Top = Target.Offset(9).Top
            .Left = Target.Offset(, 1).Left
        End With
        With ActiveSheet.Shapes("CommandButton5")
            .Top = Target.Offset(11).Top
            .Left = Target.Offset(, 1).Left
        End With
    End If
    
Exitsub:
    Application.EnableEvents = True
End Sub

此代码检查用户是否对下拉列表进行了更改,并允许多次选择而不重复。它还检查用户是否选择了单元格A1,并相应地更新导航按钮的位置。
请注意,这假定您已将Label和CommandButton形状放置在工作表中,并将它们命名为“Label1”、“CommandButton1”、“CommandButton2”等。如果您还没有这样做,您需要将这些形状添加到工作表中,并为它们给予适当的名称。

相关问题