With cBtn
.Style = msoButtonIconAndCaption
.FaceId = (i + 1) + 200
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)
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = (i + 1) + 200
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)
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = (i + 1) + 200
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)
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)
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" <scrat83@free.fr> a écrit dans le message de
news:O2WpaMveEHA.2604@TK2MSFTNGP12.phx.gbl...
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)
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)
ArrProcs(0, UBound(ArrProcs, 2)) = .ProcOfLine(StartLine,
vbext_pk_Proc)
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éfautMsgBox "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)
ArrProcs(0, UBound(ArrProcs, 2)) = .ProcOfLine(StartLine,
vbext_pk_Proc)
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:O6tnOVveEHA.2812@tk2msftngp13.phx.gbl...
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" <scrat83@free.fr> a écrit dans le message de
news:O2WpaMveEHA.2604@TK2MSFTNGP12.phx.gbl...
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)
ArrProcs(0, UBound(ArrProcs, 2)) = .ProcOfLine(StartLine,
vbext_pk_Proc)
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éfautMsgBox "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)
Bonjour Domi et Pascal
Je ne sais pas si c'est ce que tu voulais Domi, mais cette proc parcourt
un module donné pour
affecter à chaque sub de ce module un bouton avec une FaceId. On peut
éventuellement le simplifier
pour ton besoin.
j-p
Bonjour Domi et Pascal
Je ne sais pas si c'est ce que tu voulais Domi, mais cette proc parcourt
un module donné pour
affecter à chaque sub de ce module un bouton avec une FaceId. On peut
éventuellement le simplifier
pour ton besoin.
j-p
Bonjour Domi et Pascal
Je ne sais pas si c'est ce que tu voulais Domi, mais cette proc parcourt
un module donné pour
affecter à chaque sub de ce module un bouton avec une FaceId. On peut
éventuellement le simplifier
pour ton besoin.
j-p
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
peuxt'envoyer en BAL directe le fichier de FS, il n'y a que sa barre dessus
(35ko 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
dontFrederic 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éfautMsgBox "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
AUPOINT)
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" <scrat83@free.fr> a écrit dans le message de
news:%23lx7%235veEHA.3028@TK2MSFTNGP12.phx.gbl...
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:O6tnOVveEHA.2812@tk2msftngp13.phx.gbl...
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" <scrat83@free.fr> a écrit dans le message de
news:O2WpaMveEHA.2604@TK2MSFTNGP12.phx.gbl...
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)
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
peuxt'envoyer en BAL directe le fichier de FS, il n'y a que sa barre dessus
(35ko 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
dontFrederic 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éfautMsgBox "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
AUPOINT)
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
peuxt'envoyer en BAL directe le fichier de FS, il n'y a que sa barre
dessus
(35ko 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
dontFrederic 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
ceuxdé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éfautMsgBox "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
MISEAUPOINT)
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" <pasquestion@nonmais> a écrit dans le message de
news:uDPKAnweEHA.1644@tk2msftngp13.phx.gbl...
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" <scrat83@free.fr> a écrit dans le message de
news:%23lx7%235veEHA.3028@TK2MSFTNGP12.phx.gbl...
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:O6tnOVveEHA.2812@tk2msftngp13.phx.gbl...
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" <scrat83@free.fr> a écrit dans le message de
news:O2WpaMveEHA.2604@TK2MSFTNGP12.phx.gbl...
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)
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
peuxt'envoyer en BAL directe le fichier de FS, il n'y a que sa barre
dessus
(35ko 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
dontFrederic 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
ceuxdé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éfautMsgBox "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
MISEAUPOINT)
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
desmessages 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
faisdisparaî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èsles , (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
ette 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,
jepeuxt'envoyer en BAL directe le fichier de FS, il n'y a que sa barre
dessus(35ko 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'outilsdontFrederic 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
ceuxdéfinis... (201, 202, 203...) le code est vraiment trop évolué
pourmoi !
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
dubouton('§)
'la seconde ligne de commentaire determine la propriété FaceId
du
bouton('§)
'seules les procédures déclarées explicitement Public sont
prises
encompte'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
AUPOINT)
'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éfautMsgBox "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
MISEAUPOINT)
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" <scrat83@free.fr> a écrit dans le message de
news:u4JeeZ6eEHA.1048@tk2msftngp13.phx.gbl...
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" <pasquestion@nonmais> a écrit dans le message de
news:uDPKAnweEHA.1644@tk2msftngp13.phx.gbl...
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" <scrat83@free.fr> a écrit dans le message de
news:%23lx7%235veEHA.3028@TK2MSFTNGP12.phx.gbl...
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:O6tnOVveEHA.2812@tk2msftngp13.phx.gbl...
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" <scrat83@free.fr> a écrit dans le message de
news:O2WpaMveEHA.2604@TK2MSFTNGP12.phx.gbl...
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)
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
desmessages 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
faisdisparaî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èsles , (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
ette 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,
jepeuxt'envoyer en BAL directe le fichier de FS, il n'y a que sa barre
dessus(35ko 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'outilsdontFrederic 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
ceuxdéfinis... (201, 202, 203...) le code est vraiment trop évolué
pourmoi !
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
dubouton('§)
'la seconde ligne de commentaire determine la propriété FaceId
du
bouton('§)
'seules les procédures déclarées explicitement Public sont
prises
encompte'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
AUPOINT)
'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éfautMsgBox "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
MISEAUPOINT)
Bonjour Domi
Voila le code de frédéric adapté. Tu as juste à renseigner les 3
premières variables avant de la
lancer.
j-p
Sub CreateBarreActions3()
' Basé sur un Code de FS
Dim cBar As CommandBar
Dim cBtn As CommandBarButton
Dim NomBar As String
Dim NomMacro1 As String
Dim NomMacro2 As String
NomMacro1 = "test1"
NomMacro2 = "test2"
NomBar = "BarDomi"
'crée la barre et les boutons
DelBarreActions2
Set cBar = Application.CommandBars.Add(NomBar) ' création barre
Set cBtn = cBar.Controls.Add(msoControlButton) ' création bouton1
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = 25
.Caption = NomMacro1
.OnAction = NomMacro1
End With
Set cBtn = cBar.Controls.Add(msoControlButton) ' création bouton2
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = 200
.Caption = NomMacro2
.OnAction = NomMacro2
End With
cBar.Visible = True
End Sub
Sub DelBarreActions2()
On Error Resume Next
Application.CommandBars(NomBar).Delete
End Sub
Bonjour Domi
Voila le code de frédéric adapté. Tu as juste à renseigner les 3
premières variables avant de la
lancer.
j-p
Sub CreateBarreActions3()
' Basé sur un Code de FS
Dim cBar As CommandBar
Dim cBtn As CommandBarButton
Dim NomBar As String
Dim NomMacro1 As String
Dim NomMacro2 As String
NomMacro1 = "test1"
NomMacro2 = "test2"
NomBar = "BarDomi"
'crée la barre et les boutons
DelBarreActions2
Set cBar = Application.CommandBars.Add(NomBar) ' création barre
Set cBtn = cBar.Controls.Add(msoControlButton) ' création bouton1
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = 25
.Caption = NomMacro1
.OnAction = NomMacro1
End With
Set cBtn = cBar.Controls.Add(msoControlButton) ' création bouton2
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = 200
.Caption = NomMacro2
.OnAction = NomMacro2
End With
cBar.Visible = True
End Sub
Sub DelBarreActions2()
On Error Resume Next
Application.CommandBars(NomBar).Delete
End Sub
Bonjour Domi
Voila le code de frédéric adapté. Tu as juste à renseigner les 3
premières variables avant de la
lancer.
j-p
Sub CreateBarreActions3()
' Basé sur un Code de FS
Dim cBar As CommandBar
Dim cBtn As CommandBarButton
Dim NomBar As String
Dim NomMacro1 As String
Dim NomMacro2 As String
NomMacro1 = "test1"
NomMacro2 = "test2"
NomBar = "BarDomi"
'crée la barre et les boutons
DelBarreActions2
Set cBar = Application.CommandBars.Add(NomBar) ' création barre
Set cBtn = cBar.Controls.Add(msoControlButton) ' création bouton1
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = 25
.Caption = NomMacro1
.OnAction = NomMacro1
End With
Set cBtn = cBar.Controls.Add(msoControlButton) ' création bouton2
With cBtn
.Style = msoButtonIconAndCaption
.FaceId = 200
.Caption = NomMacro2
.OnAction = NomMacro2
End With
cBar.Visible = True
End Sub
Sub DelBarreActions2()
On Error Resume Next
Application.CommandBars(NomBar).Delete
End Sub