Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel VBA Creation Menu, code de FS...

VBA Creation Menu, code de FS...

2 réponses
Avatar
Domi
Bonjour à tous,
J'ai téléchargé un classeur exemple de Frederic Sigonneau pour la création
de barre Menu
J'aimerai bien essayer de mettre son code dans une applic perso mais n'etant
pas spécialiste en VBa je coince sur un petit pb...
Après avoir copié les modules de son exemple dans mon applic et mise à jour
l'ouverture du Workbook, j'ai systématiquement ce message d'erreur au
démarrage : sur la première ligne "Dim VBCodeModule As codeModule"

Type defini par l'utilisateur non defini...
Je suppose que c'est tout bête mais je coince ! j'ai pourtant l'impression
de n'avoir rien oublié lors de la copie... ou alors c'est du code déjà
existant dans mon applic qui parasite ?

Merci
Domi


Sub CreateBarreActions2()
Dim VBCodeModule As codeModule ' ça coince là
Dim StartLine As Long
Dim tmp As String
Dim LineProc As Long
Dim Wbk As Workbook
Dim LeModule As String
Dim ArrProcs()
Dim cBar As CommandBar
Dim cBtn As CommandBarButton

Set Wbk = ThisWorkbook: LeModule = "actionsPubliques"
Set VBCodeModule = Wbk.VBProject.VBComponents(LeModule).codeModule
ReDim ArrProcs(0 To 1, 0)
'récupère les noms des procs et les captions dans un tableau
With VBCodeModule
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
ArrProcs(0, UBound(ArrProcs, 2)) = .ProcOfLine(StartLine,
vbext_pk_Proc)
LineProc = .ProcBodyLine(.ProcOfLine(StartLine, vbext_pk_Proc),
vbext_pk_Proc)
tmp = .Lines(LineProc + 1, 1): pos = InStr(1, tmp, "§")
If pos > 0 Then
ArrProcs(1, UBound(ArrProcs, 2)) = Trim(Mid(tmp, pos + 1))
End If
StartLine = StartLine + _
.ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc),
vbext_pk_Proc)
i = i + 1
If ArrProcs(0, UBound(ArrProcs, 2)) <> "" Then
ReDim Preserve ArrProcs(0 To 1, UBound(ArrProcs, 2) + 1)
End If
Loop
End With

'crée la barre et les boutons
DelBarreActions2
Set cBar = Application.CommandBars.Add(NomBar)
For i = LBound(ArrProcs, 2) To UBound(ArrProcs, 2) - 1
Set cBtn = cBar.Controls.Add(msoControlButton)
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = (i + 1) + 200
If ArrProcs(1, i) <> "" Then
.Caption = ArrProcs(1, i)
Else: .Caption = ArrProcs(0, i)
End If
.OnAction = ArrProcs(0, i)
End With
Next
cBar.Visible = True
End Sub
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
papou
Bonjour
Ajouter une référence à "Microsoft Visual Basic For Application
Extensibility 5.3" dans Outils Références.

Cordialement
Pascal

"Domi" a écrit dans le message de
news:
Bonjour à tous,
J'ai téléchargé un classeur exemple de Frederic Sigonneau pour la création
de barre Menu
J'aimerai bien essayer de mettre son code dans une applic perso mais
n'etant

pas spécialiste en VBa je coince sur un petit pb...
Après avoir copié les modules de son exemple dans mon applic et mise à
jour

l'ouverture du Workbook, j'ai systématiquement ce message d'erreur au
démarrage : sur la première ligne "Dim VBCodeModule As codeModule"

Type defini par l'utilisateur non defini...
Je suppose que c'est tout bête mais je coince ! j'ai pourtant l'impression
de n'avoir rien oublié lors de la copie... ou alors c'est du code déjà
existant dans mon applic qui parasite ?

Merci
Domi


Sub CreateBarreActions2()
Dim VBCodeModule As codeModule ' ça coince là
Dim StartLine As Long
Dim tmp As String
Dim LineProc As Long
Dim Wbk As Workbook
Dim LeModule As String
Dim ArrProcs()
Dim cBar As CommandBar
Dim cBtn As CommandBarButton

Set Wbk = ThisWorkbook: LeModule = "actionsPubliques"
Set VBCodeModule = Wbk.VBProject.VBComponents(LeModule).codeModule
ReDim ArrProcs(0 To 1, 0)
'récupère les noms des procs et les captions dans un tableau
With VBCodeModule
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
ArrProcs(0, UBound(ArrProcs, 2)) = .ProcOfLine(StartLine,
vbext_pk_Proc)
LineProc = .ProcBodyLine(.ProcOfLine(StartLine, vbext_pk_Proc),
vbext_pk_Proc)
tmp = .Lines(LineProc + 1, 1): pos = InStr(1, tmp, "§")
If pos > 0 Then
ArrProcs(1, UBound(ArrProcs, 2)) = Trim(Mid(tmp, pos + 1))
End If
StartLine = StartLine + _
.ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc),
vbext_pk_Proc)
i = i + 1
If ArrProcs(0, UBound(ArrProcs, 2)) <> "" Then
ReDim Preserve ArrProcs(0 To 1, UBound(ArrProcs, 2) + 1)
End If
Loop
End With

'crée la barre et les boutons
DelBarreActions2
Set cBar = Application.CommandBars.Add(NomBar)
For i = LBound(ArrProcs, 2) To UBound(ArrProcs, 2) - 1
Set cBtn = cBar.Controls.Add(msoControlButton)
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = (i + 1) + 200
If ArrProcs(1, i) <> "" Then
.Caption = ArrProcs(1, i)
Else: .Caption = ArrProcs(0, i)
End If
.OnAction = ArrProcs(0, i)
End With
Next
cBar.Visible = True
End Sub




Avatar
Domi
Et la lumière fut. Je me doutais d'un truc de ce genre...
Merci beaucoup ;o)
Domi

"papou" <cestpasbonprobin@çanonpluscg44.fr> a écrit dans le message de
news:
Bonjour
Ajouter une référence à "Microsoft Visual Basic For Application
Extensibility 5.3" dans Outils Références.

Cordialement
Pascal

"Domi" a écrit dans le message de
news:
Bonjour à tous,
J'ai téléchargé un classeur exemple de Frederic Sigonneau pour la
création


de barre Menu
J'aimerai bien essayer de mettre son code dans une applic perso mais
n'etant

pas spécialiste en VBa je coince sur un petit pb...
Après avoir copié les modules de son exemple dans mon applic et mise à
jour

l'ouverture du Workbook, j'ai systématiquement ce message d'erreur au
démarrage : sur la première ligne "Dim VBCodeModule As codeModule"

Type defini par l'utilisateur non defini...
Je suppose que c'est tout bête mais je coince ! j'ai pourtant
l'impression


de n'avoir rien oublié lors de la copie... ou alors c'est du code déjà
existant dans mon applic qui parasite ?

Merci
Domi


Sub CreateBarreActions2()
Dim VBCodeModule As codeModule ' ça coince là
Dim StartLine As Long
Dim tmp As String
Dim LineProc As Long
Dim Wbk As Workbook
Dim LeModule As String
Dim ArrProcs()
Dim cBar As CommandBar
Dim cBtn As CommandBarButton

Set Wbk = ThisWorkbook: LeModule = "actionsPubliques"
Set VBCodeModule = Wbk.VBProject.VBComponents(LeModule).codeModule
ReDim ArrProcs(0 To 1, 0)
'récupère les noms des procs et les captions dans un tableau
With VBCodeModule
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
ArrProcs(0, UBound(ArrProcs, 2)) = .ProcOfLine(StartLine,
vbext_pk_Proc)
LineProc = .ProcBodyLine(.ProcOfLine(StartLine, vbext_pk_Proc),
vbext_pk_Proc)
tmp = .Lines(LineProc + 1, 1): pos = InStr(1, tmp, "§")
If pos > 0 Then
ArrProcs(1, UBound(ArrProcs, 2)) = Trim(Mid(tmp, pos + 1))
End If
StartLine = StartLine + _
.ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc),
vbext_pk_Proc)
i = i + 1
If ArrProcs(0, UBound(ArrProcs, 2)) <> "" Then
ReDim Preserve ArrProcs(0 To 1, UBound(ArrProcs, 2) + 1)
End If
Loop
End With

'crée la barre et les boutons
DelBarreActions2
Set cBar = Application.CommandBars.Add(NomBar)
For i = LBound(ArrProcs, 2) To UBound(ArrProcs, 2) - 1
Set cBtn = cBar.Controls.Add(msoControlButton)
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = (i + 1) + 200
If ArrProcs(1, i) <> "" Then
.Caption = ArrProcs(1, i)
Else: .Caption = ArrProcs(0, i)
End If
.OnAction = ArrProcs(0, i)
End With
Next
cBar.Visible = True
End Sub