Excel 如何使用VBA添加自定义功能区选项卡？

我正在寻找一种在Excel功能区中添加自定义选项卡的方法，该选项卡将带有几个按钮。我偶然在谷歌上找到了一些资源来解决这个问题，但这些资源看起来都很狡猾，复杂得离谱

什么是快速简单的方法？我希望在将VBA加载到Excel时加载新选项卡

更新： 我从中尝试了此示例，但在最后一条指令中出现“需要对象”错误：

Public Sub AddHighlightRibbon()
Dim ribbonXml As String

ribbonXml = "<mso:customUI xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">"
ribbonXml = ribbonXml + "  <mso:ribbon>"
ribbonXml = ribbonXml + "    <mso:qat/>"
ribbonXml = ribbonXml + "    <mso:tabs>"
ribbonXml = ribbonXml + "      <mso:tab id=""highlightTab"" label=""Highlight"" insertBeforeQ=""mso:TabFormat"">"
ribbonXml = ribbonXml + "        <mso:group id=""testGroup"" label=""Test"" autoScale=""true"">"
ribbonXml = ribbonXml + "          <mso:button id=""highlightManualTasks"" label=""Toggle Manual Task Color"" "
ribbonXml = ribbonXml + "imageMso=""DiagramTargetInsertClassic"" onAction=""ToggleManualTasksColor""/>"
ribbonXml = ribbonXml + "        </mso:group>"
ribbonXml = ribbonXml + "      </mso:tab>"
ribbonXml = ribbonXml + "    </mso:tabs>"
ribbonXml = ribbonXml + "  </mso:ribbon>"
ribbonXml = ribbonXml + "</mso:customUI>"

ActiveProject.SetCustomUI (ribbonXml)
End Sub

公共子添加HighlightRibbon（）
Dim ribbonXml作为字符串
ribbonXml=“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ribbonXml=ribbonXml+“”
ActiveProject.SetCustomUI（ribbonXml）
端接头

AFAIK您不能使用VBA Excel在Excel功能区中创建自定义选项卡。但是，可以使用VBA隐藏/显示功能区组件。此外，您上面提到的链接是针对MS Project而不是MS Excel的

我使用这个名为的免费实用程序为我的Excel应用程序/加载项创建选项卡

---

编辑：以适应OP的新请求

辅导的 以下是承诺的简短教程：

安装自定义UI编辑器（CUIE）后，打开它，然后单击文件|打开并选择相关Excel文件。在通过CUIE打开Excel文件之前，请确保该文件已关闭。我以一份全新的工作表为例

右键单击，如下图所示，然后单击“Office 2007自定义UI部件”。它将插入“customUI.xml”

接下来单击菜单插入|示例XML |自定义选项卡。您会注意到基本代码是自动生成的。现在，您可以根据自己的要求对其进行编辑

让我们检查一下代码

label=“Custom Tab”

：将“Custom Tab”替换为要为选项卡指定的名称。暂时让我们称之为“杰罗姆”

下面的部分添加了一个自定义按钮

<button id="customButton" label="Custom Button" imageMso="HappyFace" size="large" onAction="Callback" />

删除CUIE中生成的所有代码，然后粘贴上面的代码来代替该代码。保存并关闭CUIE。现在，当您打开Excel文件时，它将如下所示：

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id="MyCustomTab" label="Jerome" insertAfterMso="TabView">
<group id="customGroup1" label="First Tab">
<button id="customButton1" label="JG Button 1" imageMso="HappyFace" size="large" onAction="Callback1" />
<button id="customButton2" label="JG Button 2" imageMso="PictureBrightnessGallery" size="large" onAction="Callback2" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>

现在是代码部分。打开VBA编辑器，插入模块，然后粘贴此代码：

Public Sub Callback1(control As IRibbonControl)

    MsgBox "You pressed Happy Face"

End Sub

Public Sub Callback2(control As IRibbonControl)

    MsgBox "You pressed the Sun"

End Sub

Private Sub Workbook_Activate()

Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"

ribbonXML = "<mso:customUI      xmlns:mso='http://schemas.microsoft.com/office/2009/07/customui'>" & vbNewLine
ribbonXML = ribbonXML + "  <mso:ribbon>" & vbNewLine
ribbonXML = ribbonXML + "    <mso:qat/>" & vbNewLine
ribbonXML = ribbonXML + "    <mso:tabs>" & vbNewLine
ribbonXML = ribbonXML + "      <mso:tab id='reportTab' label='My Actions' insertBeforeQ='mso:TabFormat'>" & vbNewLine
ribbonXML = ribbonXML + "        <mso:group id='reportGroup' label='Reports' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='runReport' label='Trim' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='AppointmentColor3'      onAction='TrimSelection'/>" & vbNewLine
ribbonXML = ribbonXML + "        </mso:group>" & vbNewLine
ribbonXML = ribbonXML + "      </mso:tab>" & vbNewLine
ribbonXML = ribbonXML + "    </mso:tabs>" & vbNewLine
ribbonXML = ribbonXML + "  </mso:ribbon>" & vbNewLine
ribbonXML = ribbonXML + "</mso:customUI>"

ribbonXML = Replace(ribbonXML, """", "")

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub

Private Sub Workbook_Deactivate()

Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"

ribbonXML = "<mso:customUI           xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<mso:ribbon></mso:ribbon></mso:customUI>"

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub

将Excel文件另存为启用宏的文件。现在，当您单击笑脸或太阳时，您将看到相关的消息框：

---

希望这有帮助

我拼命挣扎，但这实际上是正确的答案。值得一提的是，我错过的是：

正如其他人所说，不能使用VBA创建CustomUI ribbon，但是，您不需要

其思想是使用Excel的文件>选项>自定义功能区创建xml功能区代码，然后将功能区导出为.customUI文件（它只是一个txt文件，其中包含xml）

现在有了窍门：您可以使用此处所指的MS工具，通过从.customUI文件复制代码，将.customUI代码包含在.xlsm文件中

将其包含在.xlsm文件中后，每次打开它时，您定义的功能区都将被删除 已将添加到用户的功能区-但请务必使用否则将丢失功能区的其余部分。退出工作簿时，功能区将被删除

从这里开始，很简单，创建功能区，从.customUI文件复制特定于功能区的xml代码，并将其放置在包装器中，如上图所示（…您的xml 顺便说一下，罗恩网站上的解释页面现在是

下面是他关于如何在功能区上启用/禁用按钮的示例

有关功能区的其他xml示例，请参见

---

此处的答案特定于使用自定义UI编辑器。我花了一些时间来创建界面，但没有那个出色的程序，所以我在这里记录解决方案，以帮助其他人决定是否需要自定义UI编辑器

我看到了以下microsoft帮助网页-。这显示了如何手动设置接口，但在指向自定义加载项代码时遇到了一些问题

要使按钮与自定义宏一起工作，请在.xlam subs中设置要调用的宏，如本SO答案中所述-。基本上，您需要将“control As IRibbonControl”参数添加到从功能区xml指向的任何模块中。此外，功能区xml应该具有onAction=“myaddin！mymodule.mysub”语法，以便正确调用外接程序加载的任何模块

---

使用这些说明，我能够创建一个excel加载项（.xlam文件），当我的VBA与加载项一起加载到excel时，该加载项会加载一个自定义选项卡。按钮执行外接程序中的代码，当我删除外接程序时，“自定义”选项卡将卸载。

我能够在Excel 2013中使用VBA完成此操作。不需要特别的编辑。您只需要Visual Basic代码编辑器，可以在“开发人员”选项卡上访问该编辑器。默认情况下，“开发人员”选项卡不可见，因此需要在“文件>选项>自定义”功能区中启用它。在“开发人员”选项卡上，单击Visual Basic按钮。代码编辑器将启动。在左侧的Project Explorer窗格中单击鼠标右键。单击“插入”菜单并选择“模块”。将以下两个子模块添加到新模块中

Sub LoadCustRibbon()

Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"

ribbonXML = "<mso:customUI      xmlns:mso='http://schemas.microsoft.com/office/2009/07/customui'>" & vbNewLine
ribbonXML = ribbonXML + "  <mso:ribbon>" & vbNewLine
ribbonXML = ribbonXML + "    <mso:qat/>" & vbNewLine
ribbonXML = ribbonXML + "    <mso:tabs>" & vbNewLine
ribbonXML = ribbonXML + "      <mso:tab id='reportTab' label='Reports' insertBeforeQ='mso:TabFormat'>" & vbNewLine
ribbonXML = ribbonXML + "        <mso:group id='reportGroup' label='Reports' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='runReport' label='PTO' "   & vbNewLine
ribbonXML = ribbonXML + "imageMso='AppointmentColor3'      onAction='GenReport'/>" & vbNewLine
ribbonXML = ribbonXML + "        </mso:group>" & vbNewLine
ribbonXML = ribbonXML + "      </mso:tab>" & vbNewLine
ribbonXML = ribbonXML + "    </mso:tabs>" & vbNewLine
ribbonXML = ribbonXML + "  </mso:ribbon>" & vbNewLine
ribbonXML = ribbonXML + "</mso:customUI>"

ribbonXML = Replace(ribbonXML, """", "")

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub

Sub ClearCustRibbon()

Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String

hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"

ribbonXML = "<mso:customUI           xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
"<mso:ribbon></mso:ribbon></mso:customUI>"

Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile

End Sub

Sub-LoadCustRibbon（）
暗文件一样长
Dim路径为字符串，文件名为字符串，ribbonXML为字符串，用户为字符串
hFile=FreeFile
用户=环境（“用户名”）
path=“C:\Users\”&user&“\AppData\Local\Microsoft\Office\”
fileName=“Excel.officeUI”
ribbonXML=”“&vbNewLine
ribbonXML=ribbonXML+“”&vbNewLine
ribbonXML=ribbonXML+“”&vbNewLine
ribbonXML=ribbonXML+“”&vbNewLine
ribbonXML=ribb
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" xmlns:x="sao">
  <ribbon>
    <tabs>
      <tab idQ="x:chartToolsTab" label="Chart Tools">
        <group id="relativeChartMovementGroup" label="Relative Chart Movement" >
            <button id="moveChartWithRelativeLinksButton" label="Copy and Move" imageMso="ResultsPaneStartFindAndReplace" onAction="MoveChartWithRelativeLinksCallBack" visible="true" size="normal"/>
            <button id="moveChartToManySheetsWithRelativeLinksButton" label="Copy and Distribute" imageMso="OutlineDemoteToBodyText" onAction="MoveChartToManySheetsWithRelativeLinksCallBack" visible="true" size="normal"/>
        </group >
        <group id="chartDeletionGroup" label="Chart Deletion">
            <button id="deleteAllChartsInWorkbookSharingAnAddressButton" label="Delete Charts" imageMso="CancelRequest" onAction="DeleteAllChartsInWorkbookSharingAnAddressCallBack" visible="true" size="normal"/>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" xmlns:x="sao">
  <ribbon>
    <tabs>
      <tab idQ="x:privelgedUDFsTab" label="Privelged UDFs">
        <group id="privelgedUDFsGroup" label="Toggle" >
            <button id="initialisePrivelegedUDFsButton" label="Activate" imageMso="TagMarkComplete" onAction="InitialisePrivelegedUDFsCallBack" visible="true" size="normal"/>
            <button id="deInitialisePrivelegedUDFsButton" label="De-Activate" imageMso="CancelRequest" onAction="DeInitialisePrivelegedUDFsCallBack" visible="true" size="normal"/>
        </group >
      </tab>
    </tabs>
  </ribbon>
</customUI>

<Relationship Type="http://schemas.microsoft.com/office/2006/
  relationships/ui/extensibility" Target="/customUI/customUI.xml" 
  Id="customUIRelID" />

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
    <Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">
        <Relationship Id="rId3" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId2" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/>
        <Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/>
        <Relationship Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="/customUI/customUI.xml" Id="chartToolsCustomUIRel" />
    </Relationships>

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
    <Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">
        <Relationship Id="rId3" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId2" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/>
        <Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/>
        <Relationship Type="http://schemas.microsoft.com/office/2006/relationships/ui/extensibility" Target="/customUI/customUI.xml" Id="privelegedUDFsCustomUIRel" />
    </Relationships>

Option Explicit

Public Sub MoveChartWithRelativeLinksCallBack(ByRef control As IRibbonControl)
  MoveChartWithRelativeLinks
End Sub

Public Sub MoveChartToManySheetsWithRelativeLinksCallBack(ByRef control As IRibbonControl)
  MoveChartToManySheetsWithRelativeLinks
End Sub

Public Sub DeleteAllChartsInWorkbookSharingAnAddressCallBack(ByRef control As IRibbonControl)
  DeleteAllChartsInWorkbookSharingAnAddress
End Sub

Public Sub InitialisePrivelegedUDFsCallBack(ByRef control As IRibbonControl)
  ThisWorkbook.InitialisePrivelegedUDFs
End Sub

Public Sub DeInitialisePrivelegedUDFsCallBack(ByRef control As IRibbonControl)
  ThisWorkbook.DeInitialisePrivelegedUDFs
End Sub

Option Explicit

Sub sbHelloWorld()
 MsgBox "Hello World!"
End Sub

<mso:customUI      xmlns:mso='http://schemas.microsoft.com/office/2009/07/customui'>
    <mso:ribbon>
        <mso:qat/>
        <mso:tabs>
        <mso:tab idQ="mso:TabDrawInk" visible="false"/>
        <mso:tab id="mso_c1.2A492F1" label="New Tab">
            <mso:group id="mso_c2.2A492F1" label="New Group" autoScale="true">
                <mso:button id="sbHelloWorld" label="sbHelloWorld" imageMso="ListMacros" onAction="sbHelloWorld" visible="true"/>
            </mso:group>
        </mso:tab>
        </mso:tabs>
    </mso:ribbon>
</mso:customUI>

Sub sbCopyFile()
 Dim sOfficeUIDir As String
 Dim sHWFile As String
 Dim sUIFile As String
 Dim sTest As String
 sOfficeUIDir = "C:\Users\david\AppData\Local\Microsoft\Office\"
 sHWFile = sOfficeUIDir & "rb_HelloWorld.txt"
 sUIFile = sOfficeUIDir & "Excel.officeUI"
 sTest = Dir(sHWFile)
 If Not sTest = "" Then
  FileCopy sHWFile, sUIFile
 End If
End Sub



Sub sbDeleteFile()
 Dim sOfficeUIDir As String
 Dim sUIFile As String
 Dim sTest As String
 sOfficeUIDir = "C:\Users\david\AppData\Local\Microsoft\Office\"
 sUIFile = sOfficeUIDir & "Excel.officeUI"
 sTest = Dir(sUIFile)
 If Not sTest = "" Then
  Kill (sUIFile)
 End If
End Sub

Private Sub Workbook_Activate()
 Call sbCopyFile
End Sub

Private Sub Workbook_Deactivate()
 Call sbDeleteFile
End Sub