Excel 功能区上的永久退出按钮答案

【问题标题】：Permanent exit button on Excel ribbonExcel 功能区上的永久退出按钮
【发布时间】：2016-11-19 02:13:45
【问题描述】：

我有一个 Excel 工作簿，其中包含数百个选项卡，除非需要，否则这些选项卡都非常隐藏。我进行了设置，以便用户可以从主工作表中选择数据源，并将它们传输到他们需要的特定工作表。然后，当他们完成任务时，他们会返回主工作表，一切都再次被隐藏。我需要一种将命令按钮附加到功能区的方法，以便它始终存在并隐藏除主工作表之外的所有内容。

我曾尝试在每张纸上放置一个按钮，甚至尝试在角落放置一个浮动表单。虽然这些是答案，但我更愿意在功能区上附加一个按钮而忘记它。但是如何在功能区中动态创建一个按钮，该按钮将与工作簿一起传输，以便任何计算机上的每个用户都可以使用该按钮？

【问题讨论】：

使用QAT而不是按钮
您无法在 VBA 中创建功能区控件，但如果您通过Application.CommandBars 使用CommandBars API，它将在“加载项”功能区选项卡下创建您的按钮。在工作簿的Workbook_Open 事件处理程序中创建按钮，当该工作簿打开时它将显示。一个好主意是在工作簿关闭时也删除该按钮。
我也对此进行了探索，这里的问题是我找不到有关动态创建可以运行 VBA 代码的加载项的任何信息。加载项是必须安装或激活的预打包即插即用。
请参阅 gregmaxey.mvps.org/word_tip_pages/customize_ribbon_main.html 了解如何创建附加到工作簿的功能区自定义

标签： vba excel

【解决方案1】：

我通过为我的工作簿创建自定义选项卡和按钮找到了解决方法。它会在工作簿打开时创建选项卡，并在您关闭工作簿时将其删除。

私有子工作簿_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='Pats Tools' insertBeforeQ='mso:TabFormat'>" & vbNewLine
ribbonXML = ribbonXML + "        <mso:group id='reportGroup1' label='Month' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Months1' label='Previous' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='AccessTableEvents'      onAction='MonthPrevious.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Months2' label='Current' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='AccessListEvents'      onAction='MonthCurrent.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Months3' label='Next' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='AccessTableEvents'      onAction='MonthNext.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Months4' label='All' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='AccessTableEvents'      onAction='AllMonths.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "        </mso:group>" & vbNewLine
ribbonXML = ribbonXML + "        <mso:group id='reportGroup2' label='Properties' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Properties1' label='All' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='BlogHomePage'      onAction='AllProperties.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Properties2' label='Name1' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='BlogHomePage'      onAction='Name1.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Properties3' label='Name2' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='BlogHomePage'      onAction='Name2.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Properties4' label='Name3' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='BlogHomePage'      onAction='Name3.ClearSheet'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Properties5' label='Name4' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='BlogHomePage'      onAction='Name4.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='Properties6' label='Name5' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='BlogHomePage'      onAction='Name5.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "        </mso:group>" & vbNewLine
ribbonXML = ribbonXML + "        <mso:group id='reportGroup4' label='Edit Task' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='ActionButton1' label='Type' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='BlogHomePage'      onAction='AddTypemod.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='ActionButton2' label='Section' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='BlogHomePage'      onAction='AddSectionMod.calling'/>" & vbNewLine
ribbonXML = ribbonXML + "          <mso:button id='ActionButton3' label='Empty' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='BlogHomePage'      onAction='CedarCreek.calling'/>" & 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

【讨论】：

注意：您可以在 VBA 中使用下划线而不是在行尾使用“& vbNewLine”进行换行，并使用“&”而不是“ribbonXML =ribbonXML +”开始下一行。看起来不那么嘈杂，但是总线路限制。这是一个示例讨论：stackoverflow.com/questions/19422064/…