Как установить текст на ленте Editbox через VBA (Excel)

Question

Как установить текст в ленточном редакторе? Я не могу найти его в Интернете:/

Я просто могу найти примеры событий щелчка, но ничего не установил текст из Sub.

Так, например, я хочу что-то вроде этого:

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

Answer 1

Решение, которое я нашел по этой ссылке: http://www.shulerent.com/2011/08/16/changing-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

Прошло немного времени с тех пор, как этот ответ был опубликован, и похоже, что последнее изменение меняется на поведение ленты, что означает исходный ответ ed не может быть решением больше. Для записи я использую Excel 2013 с некоторыми обновлениями, датированными после ответа Браулио.

Главное отличие заключается в том, что Invalidate и InvalidateControl на ленте не ведут себя так же, как ранее. Это означает, что InvalidateControl не вызывает обратный вызов getText на editBox. Я заменил InvalidateControl-вызовы Invalidate (так что затягивает повторную ничью на всей ленте), и это вызывает срабатывание обратного вызова, как ожидалось.

Так вот код моего решения для кнопки filename/browse (обратите внимание, что я включил дополнительный код для кеширования ссылки на интерфейс ленты на очень скрытом листе, чтобы сбрасывать во время разработки не сделать ленту недоступной).

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" />