Hi Fane Guru
Sorry for the lateness of my reply. (vacation)
I have done what you gave me for advise. But the Tooltip text wont pup up.
This is my menu code:
Dim MyBarXLD As CommandBar
Dim MyMenubarXL As CommandBar
Dim Menu As CommandBarControl
Dim CmdItemA As CommandBarControl
Dim CmdItem2A As CommandBarControl
Dim CmdItem2B As CommandBarControl
Dim CmdItem2C As CommandBarControl
Dim CmdItem2D As CommandBarControl
Dim CmdItem2E As CommandBarControl
Dim CmdItem2F As CommandBarControl
Dim CmdItem2G As CommandBarControl
Dim CmdItem3A As CommandBarControl
Dim CmdItem3B As CommandBarControl
Dim CmdItem3C As CommandBarControl
Dim CmdItem3D As CommandBarControl
Dim EvtHandlers As New Collection
Dim MnuEvtCodeCopie As VBECmdHandler
Dim MnuEvtCopieCurseur As VBECmdHandler
Dim MnuEvtFormatCode As VBECmdHandler
Dim MnuEvtCopieSelection As VBECmdHandler
Dim MnuEvtZip As VBECmdHandler
Dim MnuEvtZipVBA As VBECmdHandler
Dim MnuEvtZipSelect As VBECmdHandler
Dim MnuEvtZipCurseur As VBECmdHandler
Public Sub Creer_Bouton()
On Error Resume Next
Application.VBE.CommandBars(1).Controls("MENU_XLD").Delete
Application.CommandBars(1).Controls("WinZip -> To XLD <-").Delete
Set MyMenubarXL = Application.CommandBars(1)
Set Menu = MyMenubarXL.Controls.Add(msoControlButton)
With Menu
.Caption = "WinZip -> To XLD <-"
.BeginGroup = True
.FaceId = 1589
.Style = msoButtonIconAndCaption
.TooltipText = "Zipper un Fichier(WinZip) destiné au forum XLD"
.OnAction = "'" & strXLDFileName & "'" & "!Zip_Only"
End With
Set MyBarXLD = Application.VBE.CommandBars(1)
Set CmdItemA = MyBarXLD.Controls.Add(Type:=msoControlPopup, temporary:=True)
CmdItemA.Caption = "MENU_XLD"
Set CmdItem2A = CmdItemA.Controls.Add(Type:=msoControlPopup, temporary:=True)
CmdItem2A.Caption = "VBA CODE --->"
Set CmdItem3A = CmdItem2A.Controls.Add(msoControlButton)
With CmdItem3A
.Caption = "VBAProject"
.BeginGroup = True
.FaceId = 3040
.Style = msoButtonIconAndCaption
.TooltipText = "Boite de dialogue pour choisir le code destiné au forum XLD"
.OnAction = "'" & strXLDFileName & "'" & "!UsfShow"
End With
Set CmdItem3C = CmdItem2A.Controls.Add(msoControlButton)
With CmdItem3C
.Caption = "Sélection"
.BeginGroup = False
.FaceId = 9986
.Style = msoButtonIconAndCaption
.TooltipText = "Copie votre sélection de code destiné au forum XLD"
.OnAction = "'" & strXLDFileName & "'" & "!Selection"
End With
Set CmdItem3D = CmdItem2A.Controls.Add(msoControlButton)
With CmdItem3D
.Caption = "Curseur"
.BeginGroup = False
.FaceId = 124
.Style = msoButtonIconAndCaption
.TooltipText = "Copie le code Curseur Position"
.OnAction = "'" & strXLDFileName & "'" & "!Curseur"
End With
Set CmdItem3B = CmdItem2A.Controls.Add(msoControlButton)
With CmdItem3B
.Caption = "Présentation"
.BeginGroup = False
.FaceId = 6986
.Style = msoButtonIconAndCaption
.TooltipText = "Changement de la mise en forme du code destiné au forum XLD"
.OnAction = "'" & strXLDFileName & "'" & "!Code_Presentation"
End With
Set CmdItem2B = CmdItemA.Controls.Add(Type:=msoControlPopup, temporary:=True)
CmdItem2B.Caption = "VBA ZIP --->"
Set CmdItem2C = CmdItem2B.Controls.Add(msoControlButton)
With CmdItem2C
.Caption = "Fichier Seulement !"
.BeginGroup = True
.FaceId = 1589
.Style = msoButtonIconAndCaption
.TooltipText = "Creation du fichier Zip et copie du lien"
.OnAction = "'" & strXLDFileName & "'" & "!Zip_Only"
End With
Set CmdItem2D = CmdItem2B.Controls.Add(Type:=msoControlPopup, temporary:=True)
CmdItem2D.Caption = "Fichier & Code --->"
Set CmdItem2E = CmdItem2D.Controls.Add(msoControlButton)
With CmdItem2E
.Caption = "Fichier + VBAProject"
.BeginGroup = True
.FaceId = 9528
.Style = msoButtonIconAndCaption
.TooltipText = "Creation du fichier Zip & Copie du code & copie du lien"
.OnAction = "'" & strXLDFileName & "'" & "!Zip_VBA"
End With
Set CmdItem2F = CmdItem2D.Controls.Add(msoControlButton)
With CmdItem2F
.Caption = "Fichier + Sélection"
.BeginGroup = True
.FaceId = 9941
.Style = msoButtonIconAndCaption
.TooltipText = "Creation du fichier Zip & Copie du Code sélectionné & copie du lien"
.OnAction = "'" & strXLDFileName & "'" & "!Zip_Selection"
End With
Set CmdItem2G = CmdItem2D.Controls.Add(msoControlButton)
With CmdItem2G
.Caption = "Fichier + Curseur"
.BeginGroup = True
.FaceId = 9254
.Style = msoButtonIconAndCaption
.TooltipText = "Creation du fichier Zip & Copie du Code selon la position du Curseur & copie du lien"
.OnAction = "'" & strXLDFileName & "'" & "!Zip_Curseur"
End With
With Application.VBE.Events
Set MnuEvtCodeCopie = New VBECmdHandler
Set MnuEvtCodeCopie.EvtHandler = .CommandBarEvents(CmdItem3A)
EvtHandlers.Add MnuEvtCodeCopie
Set MnuEvtCopieSelection = New VBECmdHandler
Set MnuEvtCopieSelection.EvtHandler = .CommandBarEvents(CmdItem3C)
EvtHandlers.Add MnuEvtCopieSelection
Set MnuEvtCopieCurseur = New VBECmdHandler
Set MnuEvtCopieCurseur.EvtHandler = .CommandBarEvents(CmdItem3D)
EvtHandlers.Add MnuEvtCopieCurseur
Set MnuEvtFormatCode = New VBECmdHandler
Set MnuEvtFormatCode.EvtHandler = .CommandBarEvents(CmdItem3B)
EvtHandlers.Add MnuEvtFormatCode
Set MnuEvtZip = New VBECmdHandler
Set MnuEvtZip.EvtHandler = .CommandBarEvents(CmdItem2C)
EvtHandlers.Add MnuEvtZip
Set MnuEvtZipVBA = New VBECmdHandler
Set MnuEvtZipVBA.EvtHandler = .CommandBarEvents(CmdItem2E)
EvtHandlers.Add MnuEvtZipVBA
Set MnuEvtZipSelect = New VBECmdHandler
Set MnuEvtZipSelect.EvtHandler = .CommandBarEvents(CmdItem2F)
EvtHandlers.Add MnuEvtZipSelect
Set MnuEvtZipCurseur = New VBECmdHandler
Set MnuEvtZipCurseur.EvtHandler = .CommandBarEvents(CmdItem2G)
EvtHandlers.Add MnuEvtZipCurseur
End With
On Error GoTo 0
End Sub
This is my Class module taht handle my menu:
Public WithEvents EvtHandler As VBIDE.CommandBarEvents
Private Sub EvtHandler_Click(ByVal CommandBarControl As Object, Handled As Boolean, CancelDefault As Boolean)
Set VBInstance = Application.VBE
With VBInstance.MainWindow
strNomWorkbook = Trim(Mid(.Caption, InStr(.Caption, "- ") + 2, InStr(.Caption, "[") - InStr(.Caption, "- ") - 2)) '.Filename .BuildFileName .Name
End With
Set VBInstance = Nothing
Application.Run CommandBarControl.OnAction
'
' Indicate to the Events object that we've successfully handled the event.
'
Handled = True
CancelDefault = True
End Sub