带有.Select或.ScrollColumn

时间:2018-07-26 07:16:34

标签: vba excel-vba

大家早上好

我在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之后的部分将完全不起作用。 有人知道为什么会这样吗?

0 个答案:

没有答案