Question

我正在尝试创建一个上下文菜单项，以便在所选单元格位置的工作表上添加一行，并执行更多操作。这是使用类clsMyControls的自定义对象来完成的，以处理我的所有自定义控件。创建的控件调用标准模块中的宏，该模块将命令转发给自定义对象MyControls。 MyControls将使用CallByName将命令转发给另一个对象。这样，我的所有自定义对象都可以使用MyControls来创建控件并将命令路由到自己的方法。

路由工作正常。我可以读取所选单元格的地址，更改值等。但是，当我尝试插入或删除行时，没有任何反应，甚至没有错误。

以下是重现该问题的代码。它实现了两种创建控件和调用Insert方法的方法。我遇到的问题，以及有效的简单方法。

第二种方法不使用MyControls并创建自己的控件。这样就可以插入一行。两种方式都调用相同对象的相同Insert方法。

编辑：[ 不同之处在于传递给宏的参数。只要参数内置到控件的.onAction-String中，insert方法就会失败。为什么？ ]

首先，（简化的）类clsMyControls应该处理我的所有自定义控件

Option Explicit
Option Base 1
Private myItems As Collection 'the collection to carry all controls created here
Private myObjects As Collection 'the collection of objects that create controls by means of this object
'____________________________    
Private Sub Class_Initialize()
    Set myItems = New Collection
    Set myObjects = New Collection
End Sub
'____________________________    
Public Sub ReturnFromMacro(Optional args As Variant)
    Debug.Print "ReturnFromMacro " & Selection.Address
    'Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 'It does not work here
    CallByName myObjects(args(1)), args(2), VbMethod 'forewarding
End Sub
'____________________________
Public Sub CreateEntry(ObjectReference As Object, ProcedureName As String, Caption As String)
Dim control As Object
With Application.CommandBars("Cell").Controls
    Set control = .Add(Type:=msoControlButton, Before:=1, Temporary:=True)
End With
With control
    .Caption = Caption
    .onAction = ThisWorkbook.name & "!myControlsMacro(" & Chr(34) & "InsertTest" & Chr(34) & "," & Chr(34) & "Insert" & Chr(34) & ")"
    .Tag = Application.ThisWorkbook.name & "_clsMyControls"
    .beginGroup = True
End With
myItems.Add control, Caption 'storing the newly created Control in a collection
myObjects.Add ObjectReference, ObjectReference.name 'storing the object in a collection to later call it
End Sub

接下来，使用myControls创建自定义控件并拥有所调用的Insert方法的类clsInsertTest。此外，它还创建了一个绕过Object MyControls

的自定义控件

Option Explicit
Dim control As Object 'the object to carry the Control that is created in this class
'____________________________    
Property Get name() As String
    name = "InsertTest"
End Property
'____________________________
Private Sub Class_Initialize()
    'asking myControls to create a control, passing Reference THIS object, The method to be called, the name of teh control
    MyControls.CreateEntry Me, "Insert", "InsertTest"
    createOwnControl 'the simple way
End Sub
'____________________________
Public Sub Insert()
    Debug.Print "Insert Called at " & Selection.Address
    Selection.Value = "clsInsertTest was here"
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 
End Sub
'____________________________   
Private Sub createOwnControl()

With Application.CommandBars("Cell").Controls
    Set control = .Add(Type:=msoControlButton, Before:=1, Temporary:=True)
End With

With control
    .Caption = "InsertTest2"
    .onAction = ThisWorkbook.name & "!InserTest2Macro"
    .Tag = Application.ThisWorkbook.name & "_clsMyControls"
    .beginGroup = True
End With

End Sub

最后，包含初始化，清理和Subs的模块，由自定义控件调用并向前移动到对象

MyControlsMacro由MyControls构建的控件调用

InsertTest2Macro由InserTest对象直接构建的控件调用

Option Base 1
Public InsertTest As clsInsertTest 'test object
Public MyControls As clsMyControls 'the Object to handle my controls
'____________________________     
Sub CleanUp() 'what it says
Set InsertTest = Nothing
Set MyControls = Nothing
Dim control As Object
    For Each control In Application.CommandBars("Cell").Controls
        If control.Tag = Application.ThisWorkbook.name & "_clsMyControls" Then
           control.Delete
        End If
    Next control
'Application.CommandBars("Cell").Reset 'just in case...
End Sub
'____________________________     
Sub CreateTestObject() 'create my objects (calld at wb open)
    Set MyControls = New clsMyControls
    Set InsertTest = New clsInsertTest
End Sub
'____________________________     
Public Sub myControlsMacro(ParamArray args() As Variant) 'the Sub to foreward the commands to my Controls handler
Dim handover() As String
Dim wert As Variant

Debug.Print "myControlsMacro called at " & Selection.Address
'Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove 'does not work

'transforming the ParamArray "args"  into an Array of strings to be able to pass it to the next method
For Each wert In args
    If Not (Not handover) Then
        ReDim Preserve handover(UBound(handover) + 1)
    Else
        ReDim handover(1)
    End If
    handover(UBound(handover)) = wert
Next
'calling the object to handle my Controls
MyControls.ReturnFromMacro handover

End Sub
'____________________________
Public Sub InserTest2Macro() ' the simple way
    Debug.Print "InserTest2Macro called at " & Selection.Address
    CallByName InsertTest, "Insert", VbMethod
End Sub

Answer 1

我在这里找到了解决方案：

Excel VBA CommandBar.OnAction with params is difficult / does not perform as expected

.onAction和删除括号中的单引号使其有效。

.onAction = ThisWorkbook.name & "!'myControlsMacro " & Chr(34) & "InsertTest" &_
Chr(34) & "," & Chr(34) & "Insert" & Chr(34) & "'"

Excel vba - 无法使用自定义上下文菜单插入行

1 个答案: