自定义function区中的文本值
我使用VBA(而不是自定义用户界面编辑器)创build了一个自定义function区,我需要一个简单的静态文本显示单元格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
所有的button工作正常,我已经find许多代码显示如何添加一个可编辑框,但没有显示一个简单的静态框显示单元格的值。
你需要一个带有VBA函数callback的editBox-control或者labelControl,就像你在例子中的onAction事件一样。
我不能让你的示例代码工作,所以这是一个普遍的例子。 如果你想要一个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