自定义功能区中的文本值

Question

我使用 VBA（不是自定义 UI 编辑器）创建了一个自定义功能区，我需要一个简单的静态文本来显示单元格 A1 的值，但我找不到 XML 代码。这就是我所拥有的：

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 = ribbonXML + "<mso:ribbon startFromScratch='true' />" & vbNewLine

ribbonXML = "<customUI      xmlns='http://schemas.microsoft.com/office/2009/07/customui'>" & vbNewLine
ribbonXML = ribbonXML + "   <ribbon startFromScratch = 'true'>" & vbNewLine
ribbonXML = ribbonXML + "    <qat/>" & vbNewLine
ribbonXML = ribbonXML + "    <tabs>" & vbNewLine


ribbonXML = ribbonXML + "      <tab id='Menu' label='Menu' insertBeforeQ='mso:TabFormat'>" & vbNewLine
'grupo geral
ribbonXML = ribbonXML + "        <group id='geral' label='Geral' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <button id='capa' label='Capa' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='RmsNavigationBarHome'      onAction='Capa1'/>" & vbNewLine


ribbonXML = ribbonXML + "          <button id='resumo' label='Resumo' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='ChartChangeType'      onAction='resumo1'/>" & vbNewLine
ribbonXML = ribbonXML + "        </group>" & vbNewLine
'grupo performance

ribbonXML = ribbonXML + "        <group id='performance' label='Performance' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <button id='prom' label='Prom' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='CopyToPersonalContacts'      onAction='prom1'/>" & vbNewLine

ribbonXML = ribbonXML + "          <button id='super' label='Super' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='WorkgroupAdmin'      onAction='super1'/>" & vbNewLine

ribbonXML = ribbonXML + "          <button id='ranking' label='Ranking' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='Numbering'      onAction='ranking1'/>" & vbNewLine

ribbonXML = ribbonXML + "        </group>" & vbNewLine


'Cliente
ribbonXML = ribbonXML + "        <group id='cliente' label='Cliente' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <button id='Responsible' label='Responsible' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='OrganizationChartInsert'      onAction='responsavel1'/>" & vbNewLine

ribbonXML = ribbonXML + "          <button id='des' label='Des' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='GroupJunkEmail'      onAction='des1'/>" & vbNewLine
ribbonXML = ribbonXML + "        </group>" & vbNewLine

'relatorios novo
ribbonXML = ribbonXML + "        <group id='relatorios1' label='Relatorios' autoScale='true'>" & vbNewLine
ribbonXML = ribbonXML + "          <button id='an' label='An' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='TrustCenter'      onAction='historico1'/>" & vbNewLine

ribbonXML = ribbonXML + "          <button id='causas' label='Causas' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='GroupContactOptions'      onAction='causas1'/>" & vbNewLine

ribbonXML = ribbonXML + "          <button id='reenvios' label='Reenvios' " & vbNewLine
ribbonXML = ribbonXML + "imageMso='ProposeNewTime'      onAction='reenvios1'/>" & vbNewLine

ribbonXML = ribbonXML + "        </group>" & vbNewLine


'reenvios
'ribbonXML = ribbonXML + "        <group id='reenvios' label='Reenvios' autoScale='true'>" & vbNewLine
'ribbonXML = ribbonXML + "          <button id='reenvios' label='Reenvios' " & vbNewLine
'ribbonXML = ribbonXML + "imageMso='AppointmentColor8'      onAction='reenvios1'/>" & vbNewLine
'
'ribbonXML = ribbonXML + "        </group>" & vbNewLine



ribbonXML = ribbonXML + "      </tab>" & vbNewLine
'ribbonXML = ribbonXML + "    <tab mso:tab label ='Inserir' visible='false'>"
ribbonXML = ribbonXML + "    </tabs>" & vbNewLine

ribbonXML = ribbonXML + "  </ribbon>" & vbNewLine
ribbonXML = ribbonXML + "</customUI>"

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

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

End Sub

所有按钮都可以正常工作，我发现很多代码展示了如何添加可编辑框，但是 none 展示了一个显示单元格值的简单静态框。

Answer 1

您需要一个 editBox-control 或 labelControl，带有对 VBA 函数的回调，就像示例中的 onAction-events 一样。

不过我无法让您的示例代码正常工作，所以这是一个通用示例。如果你想要一个 labelControl，相同的 getText-sub 将起作用，但 XML-代码不同。

XML:

<editBox id="txt1" getText="GetText" getEnabled="GetEnabled' />
<labelControl id="lbl1" getLabel="GetText" />

VBA:

'***** Callback for txt1 getText
Sub GetText(control As IRibbonControl, ByRef returnedVal)
    '***** Return the value in cell A1 in sheet #1 in the workbook that holds the code
    returnedVal = ThisWorkbook.Sheets(1).Cells(1, 1).Value
End Sub

'***** Callback for txt1 getEnabled
Sub GetEnabled(control As IRibbonControl, ByRef returnedVal)
    '***** Return wheter you want the editBox to be enabled or not
    returnedVal = True
End Sub

自定义功能区中的文本值

Text value in custom Ribbon

excel

vba

ribbon