Question

我有一个宏，它将创建一个ActiveX控件命令按钮作为对象。

Dim buttonControl As MSForms.CommandButton

    Set buttonControl = _
        ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
            Link:=False, _
            DisplayAsIcon:=False, _
            Left:=1464, Top:=310, Width:=107.25, Height:=30).Object

    With buttonControl
        .Caption = "OPEN FOLDER"
        .Name = "cmd_OPEN_FOLDER"
        .BackColor = "12713921"

    End With

而且，我有一个宏可以打开指定的文件夹。

Private Sub cmd_OPEN_FOLDER_Click()

    Dim FolderPath As String
    Dim FinalFolder As String

    FolderPath = "C:\ExampleFolder1\ExampleFolder2\"

    FinalFolder = ActiveSheet.Range("N1").Value & "\"

        Call Shell("explorer.exe """ & FolderPath & FinalFolder & "", vbNormalFocus)

End Sub

如何让创建CommandButton的宏同时创建宏并将其与声明的CommandButton变量（buttonControl）相关联？

我希望它位于Microsoft Excel对象模块中； Sheet1（Sheet1）可以使一切井井有条。

Answer 1

要将现有的宏分配给形状，请选择它并更改OnAction属性：

Selection.OnAction = "YourMacroName"

要使用VBA创建新模块，请根据需要调整以下VBIDE技术：

Private Function addModule() As String
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
Set CodeMod = VBComp.CodeModule
With CodeMod
    .DeleteLines 1, .CountOfLines
    .InsertLines 1, "Sub ShowHide()"
    .InsertLines 2, "     If ActiveSheet.Shapes.Range(""btnHideShow"").TextFrame2.TextRange.Characters.Text = ""Show Orders with Inventory over Safety Stock"" Then"
    .InsertLines 3, "          ActiveSheet.AutoFilterMode = False"
    .InsertLines 4, "          ActiveSheet.Shapes.Range(""btnHideShow"").TextFrame2.TextRange.Characters.Text = ""Hide Orders with Inventory over Safety Stock"""
    .InsertLines 5, "     Else"
    .InsertLines 6, "          range(""M1"").select"
    .InsertLines 7, "          Selection.AutoFilter"
    .InsertLines 8, "          ActiveSheet.Range(""$A$1:$Q$1000000"").AutoFilter Field:=13, Criteria1:=""<=12"", Operator:=xlAnd"
    .InsertLines 9, "          ActiveSheet.Range(""$A$1:$Q$100000"").AutoFilter Field:=17, Criteria1:=""="""
    .InsertLines 10, "          ActiveSheet.Shapes.Range(""btnHideShow"").TextFrame2.TextRange.Characters.Text = ""Show Orders with Inventory over Safety Stock"""
    .InsertLines 11, "     End If"
    .InsertLines 12, "End Sub"
End With
addModule = VBComp.Name
End Function

以下将在Sheet1对象中创建所需的子例程：

Sub GenerateSheet1Macros()
    'assign a commandbutton, shape, event, etc to this subroutine
    addModule
End Sub

Private Function addModule() As String
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Sheet1")
Set CodeMod = VBComp.CodeModule
With CodeMod
    .DeleteLines 1, .CountOfLines
    .InsertLines 1, "Option Explicit" & vbCrLf & _
    "Sub CreateButton()" & vbCrLf & _
    "    Dim buttonControl As MSForms.CommandButton" & vbCrLf & _
    "    Set buttonControl = _" & vbCrLf & _
    "    ActiveSheet.OLEObjects.Add(ClassType:=""Forms.CommandButton.1"", _" & vbCrLf & _
    "        Link:=False, _" & vbCrLf & _
    "        DisplayAsIcon:=False, _" & vbCrLf & _
    "        Left:=100, Top:=100, Width:=100, Height:=100).Object" & vbCrLf & _
    "    With buttonControl" & vbCrLf & _
    "        .Caption = ""OPEN FOLDER""" & vbCrLf & _
    "        .Name = ""cmd_OPEN_FOLDER""" & vbCrLf & _
    "        .BackColor = ""12713921""" & vbCrLf & _
    "    End With" & vbCrLf & _
    "End Sub" & vbCrLf & _
    "Private Sub cmd_OPEN_FOLDER_Click()" & vbCrLf & _
    "    Dim FolderPath As String" & vbCrLf & _
    "    Dim FinalFolder As String" & vbCrLf & _
    "    FolderPath = ""C:\ExampleFolder1\ExampleFolder2\""" & vbCrLf & _
    "    FinalFolder = ActiveSheet.Range(""N1"").Value & "" \ """ & vbCrLf & _
    "    Call Shell(""explorer.exe """""" & FolderPath & FinalFolder & """", vbNormalFocus)" & vbCrLf & _
    "End Sub"
End With
End Function

Excel VBA将宏添加到活动工作簿的sheet1上的ActiveX控件命令按钮

1 个答案: