Bonjour,

Je souhaite créer un menu personnalisé via customUI en le générant depuis VBA. Pour les boutons, je n'ai pas de problème. Par contre, impossible de faire marcher une comboBox.
L'évènement onChange ne fonctionne pas.

Si çà se trouve c'est gros comme une maison...

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Public Sub AddMenu()
 
    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' onLoad='RibbonInitialize'>                                                  " & vbNewLine
    ribbonXML = ribbonXML + " <mso:ribbon startFromScratch='false'>                                                                                                         " & vbNewLine
    ribbonXML = ribbonXML + "   <mso:tabs>                                                                                                                                  " & vbNewLine
    ribbonXML = ribbonXML + "       <mso:tab id='ribMain' label='TEST' visible='true' insertBeforeQ='mso:TabFormat'>                                                       " & vbNewLine
    ribbonXML = ribbonXML + "           <mso:group id='grActions' label='Actions' autoScale='true'>                                                                         " & vbNewLine
    ribbonXML = ribbonXML + "               <mso:button  id='cmb_Nettoyer' label='Nettoyer' imageMso='InkDeleteAllInk' size='large' onAction='ShowMessageBox' />            " & vbNewLine
    ribbonXML = ribbonXML + "               <mso:comboBox id='cb1' getItemLabel='cbGetLabel' getItemCount='cbGetCount' onChange='ShowMessageBox' >                          " & vbNewLine
    'ribbonXML = ribbonXML + "                   <mso:item id='One' label='Mon'/>                                                                                            " & vbNewLine
    'ribbonXML = ribbonXML + "                   <mso:item id='Two' label='Tue'/>                                                                                            " & vbNewLine
    ribbonXML = ribbonXML + "               </mso:comboBox>                                                                                                                 " & vbNewLine
    ribbonXML = ribbonXML + "           </mso:group>                                                                                                                        " & vbNewLine
    ribbonXML = ribbonXML + "       </mso:tab>                                                                                                                              " & vbNewLine
    ribbonXML = ribbonXML + "   </mso:tabs>                                                                                                                                 " & vbNewLine
    ribbonXML = ribbonXML + " </mso:ribbon> "
 
 
    ribbonXML = ribbonXML + "</mso:customUI>"
    ribbonXML = Replace(ribbonXML, """", "")
 
    Open path & fileName For Output Access Write As hFile
    Print #hFile, ribbonXML
    Close hFile
 
 
End Sub
 
Public Sub RibbonInitialize(Item As IRibbonUI)
  Set MainRibbon = Item
End Sub
 
Public Sub cbChange(control As IRibbonControl, text As String)
  MsgBox text
End Sub
 
Public Sub cbGetCount(control As IRibbonControl, ByRef count)
  count = Worksheets.count - 1
End Sub
 
Public Sub cbGetLabel(control As IRibbonControl, index As Long, label)
  If index >= ActiveSheet.index - 1 Then
    label = Worksheets(index + 2).Name
  Else
    label = Worksheets(index + 1).Name
  End If
End Sub
 
Public Sub ShowMessageBox()
 
    MsgBox "test", vbInformation, "test"
 
End Sub
Merci par avance