大家早上好
我在Excel VBA中遇到一个奇怪的问题。
因此,我有这个最小的示例。它唯一要做的就是在Rightklick上下文菜单中添加一个Button。然后,此按钮应选择一个单元格。
我在StackOverflow上进行了一些搜索,找到了在.onaction
中传递字符串参数的解决方案。但是,这变得棘手。我可以分配一个范围,也可以在Mesgbox中打印地址和第二个参数。但是我无法设置断点,甚至stop
也不起作用,.select
或.ScrollColumn
也不会做任何事情。
要复制,只需将以下代码复制到标准模块中,然后执行AddContextmenu
将按钮添加到上下文菜单。
Option Explicit
Public Sub AddContextmenu()
Dim MySubMenu As CommandBarControl
Dim i As Long
'Clear Previous Menu Items
For Each MySubMenu In Application.CommandBars("Cell").Controls
If Not MySubMenu.BuiltIn Then
MySubMenu.Delete
End If
Next
'add menu
AddScrollButtons Application.CommandBars("Cell"), 1
End Sub
Public Sub AddScrollButtons(ByVal ContextMenu As CommandBar, ByVal baseindex As Long)
Dim cbb As CommandBarButton
Dim sFunction As String
'Add Button
Set cbb = ContextMenu.Controls.Add(Temporary:=True)
With cbb
sFunction = BuildProcArgString("ScrolltoColTest", "$F$10", "TestArg") ' Get Onaction string
.OnAction = sFunction
.Caption = "Scroll Tester"
.Style = msoButtonAutomatic
End With
End Sub
Function BuildProcArgString(ByVal ProcName As String, ParamArray Args() As Variant)
Dim tempArg As Variant
Dim temp As String
For Each tempArg In Args
temp = temp + Chr(34) + tempArg + Chr(34) + ","
Next
BuildProcArgString = "'" & ThisWorkbook.Name & "'!" & ProcName + "(" + Left(temp, Len(temp) - 1) + ")" ' (Workbook has to be included to ensure that the sub will be executed in the correct workbook)
End Function
Public Sub ScrolltoColTest(Addr As String, OtherArg As String)
Dim cell As Range
Set cell = ActiveSheet.Range(Addr) 'Get Cell that sould be selected from Addr
MsgBox cell.Address & vbNewLine & OtherArg 'Test if the Arguments have been passed correctly and the cell has been assigned
Stop 'Why doesn' this stop?
cell.Select 'Why doesn't this do anything
ActiveWindow.ScrollColumn = cell.Column 'Why doesn't this do anything
End Sub
正如您将在ScrolltoColTest
中看到的那样,Msgbox之后的部分将完全不起作用。
有人知道为什么会这样吗?