vba - 如何通过 VBA (Excel) 在编辑框功能区上设置文本

Question

如何在功能区编辑框中设置文本？我在互联网上找不到它：/

我只能找到点击事件的示例，但没有关于从 Sub 设置文本的内容。

例如，我想要这样的东西：

Sub settingText()
   editboxname = "my text"
end sub

Answer 1

我在此链接上找到的解决方案：http: //www.shulerent.com/2011/08/16/sharing-the-value-of-an-editbox-office-ribbon-control-at-runtime/

这是我测试过的一个例子，它运行良好：

'Global Variables:
Public MyRibbonUI As IRibbonUI
Public GBLtxtCurrentDate As String

Private Sub OnRibbonLoad(ribbonUI As IRibbonUI)

    Set MyRibbonUI = ribbonUI
    GBLtxtCurrentDate = ""

End Sub

Private Sub ocCurrentDate(control As IRibbonControl, ByRef text)

    GBLtxtCurrentDate = text
    MyRibbonUI.InvalidateControl (control.id)

End Sub

Private Sub onGetEbCurrentDate(control As IRibbonControl, ByRef text)
    text = GBLtxtCurrentDate
End Sub

Public Sub MyTest()
    'Here is an example which you are setting a text to the editbox
    'When you call InvalidateControl it is going to refresh the editbox, when it happen the onGetEbCurrentDate (which is the Gettext) will be called and the text will be atributed.
    GBLtxtCurrentDate = "09/09/2013"
    MyRibbonUI.InvalidateControl ("ebCurrentDate")
End Sub

<?xml version="1.0" encoding="UTF-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="OnRibbonLoad">
  <ribbon>
    <tabs>
      <tab id="Objects" label="Objects">
        <group id="grp" label="My Group">
          <editBox id="ebCurrentDate" label="Date" onChange="ocCurrentDate" getText="onGetEbCurrentDate"/>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

Answer 2

自发布此答案以来已经有一段时间了，并且功能区的行为似乎最近发生了变化，这意味着发布的原始答案可能不再是解决方案。作为记录，我使用的是 Excel 2013，其中一些更新是在 Braulio 的回答之后发布的。

区别的核心在于功能区上的 Invalidate 和 InvalidateControl 的行为方式与以前不同。这意味着 InvalidateControl 不会在 editBox 上调用 getText 回调。我用 Invalidate 替换了 InvalidateControl 调用（因此强制在整个功能区上重新绘制），并且确实按预期触发了回调。

所以这是我的文件名/浏览按钮解决方案的代码（请注意，我在一个非常隐藏的工作表上包含了用于缓存功能区 UI 引用的额外代码，以便在开发过程中重置不会使功能区无法访问）。

Private sobjRibbon As IRibbonUI
Private strFilename As String

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As Long)

Private Function GetRibbon() As IRibbonUI
    If sobjRibbon Is Nothing Then
        Dim objRibbon As Object
        CopyMemory objRibbon, ThisWorkbook.Worksheets("Ribbon_HACK").Range("A1").Value, 4
        Set sobjRibbon = objRibbon
    End If
    Set GetRibbon = sobjRibbon
End Function

'Callback for customUI.onLoad
Sub Ribbon_Load(ribbon As IRibbonUI)
    Set sobjRibbon = ribbon
    Dim lngRibPtr As Long
    lngRibPtr = ObjPtr(ribbon)
    ' Write pointer to worksheet for safe keeping
    ThisWorkbook.Worksheets("Ribbon_HACK").Range("A1").Value = lngRibPtr
    strFilename = ""
End Sub

'Callback for FileName onChange
Sub OnChangeFilename(control As IRibbonControl, text As String)
    strFilename = text
End Sub

'Callback for FileName getText
Sub GetFileNameText(control As IRibbonControl, ByRef returnedVal)
    returnedVal = strFilename
End Sub

'Callback for FilenameBrowse onAction (I'm looking for XML files here)
Sub OnClickFilenameBrowse(control As IRibbonControl)
    Dim objFileDialog As Office.FileDialog

    Set objFileDialog = Application.FileDialog(msoFileDialogFilePicker)

    With objFileDialog
        .AllowMultiSelect = False
        .Title = "Please select the file."
        .Filters.Clear
        .Filters.Add "XML", "*.xml"

        If .Show = True Then
            strFilename = .SelectedItems(1)
            GetRibbon().Invalidate ' Note the change here, invalidating the entire ribbon not just the individual control
        End If
    End With
End Sub

作为记录，这是我在这里处理的两个对象的 XML：

<editBox id="FileName" onChange="OnChangeFilename" screentip="Filename of the XML file to upload" label="XML file name" showImage="false" getText="GetFileNameText" />
<button id="FilenameBrowse" imageMso="ImportExcel" onAction="OnClickFilenameBrowse" screentip="Find the file to upload" label="Browse" />