（已解决）哪位大神帮忙看看原表格能使用的代码复制到新表格就不能运行的奇怪问题

百读谷歌

这个代码是匹配B列输入的内容，如果和S列的内容有匹配就自动填入或者给出选择框手动选择填入
原本在原表格可以使用，但是我把这个代码复制到新表格后就不能使用，一直报错。
哪位大神给看看是问题出在哪里了？
哪里做错了？




Dim myCel As Range
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ar, br(), i&, j&, strTarget$
     
    If Target.Count > 2 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    If Target.Value = "" Then Exit Sub
   
    ar = Range("S1", Cells(Rows.Count, "S").End(3))
    strTarget = Target.Value
    For i = 1 To UBound(ar)
        If InStr(ar(i, 1), strTarget) Then
             r = r + 1
             ReDim Preserve br(1 To r)
             br(r) = ar(i, 1)
        End If
    Next i
   
    Set myCel = Target
    If r = 0 Then
         MsgBox "未找到"
         Application.EnableEvents = False
         Target.Value = ""
         Application.EnableEvents = True
         Exit Sub
    End If
   
    If r = 1 Then
         Application.EnableEvents = False
         myCel = br(r)
         Application.EnableEvents = True
         Exit Sub
    End If

    With Application.CommandBars.Add(Name:="my112Cell", Position:=msoBarPopup)
        For i = 1 To UBound(br)
            With .Controls.Add(Type:=msoControlButton)
                .Caption = br(i)
                .OnAction = "Sheet1.myCellAction"
            End With
        Next
        .ShowPopup
        .Delete
    End With
    Set myCel = Nothing
End Sub
Sub myCellAction()
    Application.EnableEvents = False
    myCel = Application.CommandBars.ActionControl.Caption
    Application.EnableEvents = True
End Sub

ione_fox

CommandBars参数改下

zxsea_7426

没有用过这么高级的东东：不过按2楼修改还是报错。
还有楼主的原工作表中也一样报错啊。

百读谷歌

zxsea_7426 发表于 2023-4-14 23:32
没有用过这么高级的东东：不过按2楼修改还是报错。
还有楼主的原工作表中也一样报错啊。

原表格这里报错把红色那里的my112cell  改一下还能用，但是复制到新表格的报错怎么改都不行了

ione_fox

1. On Error Resume Next
   
2. Application.CommandBars("my112Cell").Delete
   
3. On Error GoTo 0
   
4. 
   
5. 
   
6.     With Application.CommandBars.Add(Name:="my112Cell", Position:=5)
   
7.         For i = 1 To UBound(br)
   
8.             With .Controls.Add(Type:=1)
   
9.                 .Caption = br(i)
   
10.                 .OnAction = "Sheet1.myCellAction"
    
11.             End With
    
12.         Next
    
13.         .ShowPopup
    
14.         .Delete
    
15.     End With

复制代码

先删除原先存在的 同名CommandBars

ione_fox

删掉原先存在的CommandBar

百读谷歌

ione_fox 发表于 2023-4-15 08:20
删掉原先存在的CommandBar

感谢。方法可行！

百读谷歌

ione_fox 发表于 2023-4-14 22:53
CommandBars参数改下

感谢。方法可行！