Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel VBA : Création barre Outils by FS, pb de FaceId...

VBA : Création barre Outils by FS, pb de FaceId...

11 réponses
Avatar
Domi
Bonjour à tous et à FS en particulier,

J'essai toujours d'adapter ce code de création d'une barre d'outils dont
Frederic Sigonneau est l'auteur.
J'ai recopié ci dessous les différents bouts de code .
Je ne parviens pas à affecter à chaque action un autre FaceId que ceux
définis... (201, 202, 203...) le code est vraiment trop évolué pour
moi !
Frederic ou un autre pro pourrais-t'il me donner un petit exemple concret
(mettre le FaceId 25 (loupe)
sur l'action 1 par exemple et 211 (tri ZA) sur action 2...)
Merci pour votre aide.
Domi



Sub CreateBarreActions2()
Dim VBCodeModule As codeModule
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

Sub DelBarreActions2()
On Error Resume Next
Application.CommandBars(NomBar).Delete
End Sub


Option Explicit
'placer les procédures utilisables dans ce module standard
'la première ligne de commentaire determine la propriété Caption du bouton
('§)
'la seconde ligne de commentaire determine la propriété FaceId du bouton
('§)
'seules les procédures déclarées explicitement Public sont prises en compte
'déclarations
Public var1 As String 'déclaration pour exemple (POUR MISE AU POINT)
Public var2 As String 'déclaration pour exemple (POUR MISE AU POINT)
Public var3 As String 'déclaration pour exemple (POUR MISE AU POINT)
'remarque 1 (POUR MISE AU POINT)

'remarque 1 avec une ligne blanche avant et une après (POUR MISE AU POINT)

'les remarques et les lignes blanches font partie de la procédure suivante
'remarque 1 (POUR MISE AU POINT)
Public Sub action1()
'§action un
'§214
'code de la procédure
MsgBox "action 1" 'pour exemple
End Sub
'remarque 2
'remarque 2
'remarque 2
Public Sub action2()
'§action deux
'§315
'code de la procédure
MsgBox "action 2" 'pour exemple
End Sub
Public Sub action3()
'§action trois
'§316
'code de la procédure
MsgBox "action 3" 'pour exemple
End Sub
Public Sub action4() 'Caption action4 par défaut, FaceId = 315 par défaut
MsgBox "action 4" 'pour exemple
End Sub
Public Sub action5()
'§action cinq
'§720
'code de la procédure
MsgBox "action 5" 'pour exemple
End Sub
Public Sub action6()
'§action six
'§720
'code de la procédure
MsgBox "action 6" 'pour exemple
End Sub

'remarque en fin avec une ligne blanche avant et une après(POUR MISE AU
POINT)
Signaler un problème avec ce contenu

1 réponse

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
1 2
Avatar
papou
Bonjour Domi
Réponse avec du retard ;-)
Comme je vois qu'un exemple simple de création de BO t'a déjà été fourni par
JPPradier, je te propose un exemple simple de création de menu dans Excel.
Fichier envoyé dans ta bal.
Cordialement
Pascal

"Domi" a écrit dans le message de
news:%23$
Avec Plaisir
A adresser à
Merci
Domi

"papou" <cestpasbonprobin@çanonpluscg44.fr> a écrit dans le message de
news:
Bonjour Domi
Si tu veux un exemple plus simple, je te propose de t'envoyer un exemple
dans ta bal.
Si ok, confirme ton adresse mél s'il te plaît
Cordialement
Pascal


"Domi" a écrit dans le message de
news:
Je n'y arrive toujours pas... j'ai tout de même réussi à me
débarrasser



des
messages relatifs aux If et For mais au détriment d'un résultat qui
n'est


plus valable... je n'ai toujours ma le FaceID que je veux et en plus
je



fais
disparaître des action dans la barre d'outils... Bref pas terrible !
Salut
Domi

"Papou" a écrit dans le message de
news:
Domi
Je ne pourrais pas le regarder ce soir.
A mon avis, il doit y avoir des espaces ou des retours à la ligne
intempestifs qui te provoquent ces erreurs.
Faire attention notamment dans le code aux sauts éventuels de ligne
après


les , (virgules) exemple "flagrant" :
ArrProcs(0, UBound(ArrProcs, 2)) .ProcOfLine(StartLine,
vbext_pk_Proc)




Si tu n'y parviens toujours pas, fais-moi signe demain et je
regarderai



et
te dirai ce qu'il est possible de faire.

Cordialement
Pascal

"Domi" a écrit dans le message de
news:%23lx7%
Merci Pascal, je crois que tu as raison... c'est pas gagné...!
J'ai ensuite des erreur sur des with sans End... puis sur des for
sans




next.... et franchement...ça me depasse.
Si tu veux faire persister un peu et faire un test en grandeur
réel,





je
peux
t'envoyer en BAL directe le fichier de FS, il n'y a que sa barre
dessus



(35
ko TTC !)
Parce que là, sans l'auteur ça risque de durer... ;o)
Merci
Domi

Bref
"papou" <cestpasbonprobin@çanonpluscg44.fr> a écrit dans le
message





de
news:
Bonjour
Bon on va essayer mais c'est pas gagné !

Tu remplaces la partie :
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = (i + 1) + 200


Par :
With cBtn
.Style = msoButtonIconAndCaption
If i +1 = 1 then
.FaceId = 25
If i + 1 = 2 then
.FaceId = 211
else
.FaceId = (i + 1) + 200 'ou éventuellement + 202 ?
End If

Cordialement
Pascal




"Domi" a écrit dans le message de
news:
Bonjour à tous et à FS en particulier,

J'essai toujours d'adapter ce code de création d'une barre
d'outils





dont
Frederic Sigonneau est l'auteur.
J'ai recopié ci dessous les différents bouts de code .
Je ne parviens pas à affecter à chaque action un autre FaceId
que






ceux
définis... (201, 202, 203...) le code est vraiment trop évolué
pour





moi !
Frederic ou un autre pro pourrais-t'il me donner un petit
exemple






concret
(mettre le FaceId 25 (loupe)
sur l'action 1 par exemple et 211 (tri ZA) sur action 2...)
Merci pour votre aide.
Domi



Sub CreateBarreActions2()
Dim VBCodeModule As codeModule
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

Sub DelBarreActions2()
On Error Resume Next
Application.CommandBars(NomBar).Delete
End Sub


Option Explicit
'placer les procédures utilisables dans ce module standard
'la première ligne de commentaire determine la propriété
Caption







du
bouton
('§)
'la seconde ligne de commentaire determine la propriété FaceId
du






bouton
('§)
'seules les procédures déclarées explicitement Public sont
prises






en
compte
'déclarations
Public var1 As String 'déclaration pour exemple (POUR MISE
AU







POINT)
Public var2 As String 'déclaration pour exemple (POUR MISE
AU







POINT)
Public var3 As String 'déclaration pour exemple (POUR MISE
AU







POINT)
'remarque 1 (POUR MISE AU POINT)

'remarque 1 avec une ligne blanche avant et une après (POUR
MISE






AU
POINT)

'les remarques et les lignes blanches font partie de la
procédure






suivante
'remarque 1 (POUR MISE AU POINT)
Public Sub action1()
'§action un
'§214
'code de la procédure
MsgBox "action 1" 'pour exemple
End Sub
'remarque 2
'remarque 2
'remarque 2
Public Sub action2()
'§action deux
'§315
'code de la procédure
MsgBox "action 2" 'pour exemple
End Sub
Public Sub action3()
'§action trois
'§316
'code de la procédure
MsgBox "action 3" 'pour exemple
End Sub
Public Sub action4() 'Caption action4 par défaut, FaceId = 315
par






défaut
MsgBox "action 4" 'pour exemple
End Sub
Public Sub action5()
'§action cinq
'§720
'code de la procédure
MsgBox "action 5" 'pour exemple
End Sub
Public Sub action6()
'§action six
'§720
'code de la procédure
MsgBox "action 6" 'pour exemple
End Sub

'remarque en fin avec une ligne blanche avant et une
après(POUR







MISE
AU
POINT)




























1 2