Menu déroulant dans Barre d'outil

Bonsoir Sunburn,
Surtout ne t'affole pas en voyant le code, suit simplement mes directives.
Sur une form tu pose (n'importe où et de n'importe quelle façon) :
- 1 CommandButton que tu nomme "CmdImprimer"
- 1 CommandButton que tu nomme "CmdApercu"
- 1 Frame que tu nomme "Cadre"
- 1 TextBox que tu nomme "TxtHautForm"
- 1 ComboBox que tu nomme "CmbControle"
- 1 CheckBox que tu nomme "ChkCacher" et que tu titre "Inclure les feuilles
cachées"
Puis dans le module de la Form, tout ce code (des pointillés aux pointillés
suivants, je l'ai je pense assez bien commenté pour plus de compréhension) :
'--------------------------------------------------
'API pour récupérer les dimensions de l'écran
'pour le centrage du formulaire
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

'Constantes pour le centrage du formulaire
Private Const LG_ECRAN = 0
Private Const HT_ECRAN = 1

'nom de la feuille active (pour la réactiver)
'tableau pour les feuilles cachées
Dim FeActive As String
Dim TblCacher() As String

'Constantes pour le dimenssionnement des contrôles
Const ESP_BTN As Integer = 2
Const LARGEUR As Integer = 70
Const HAUTEUR As Integer = 15
Const ESPACE As Integer = 6
Const DIM_BTN As Integer = 20
Const LG_BTN As Integer = 40
Const HT_BTN As Integer = 15
Const BARRE As Integer = 16

Private Sub UserForm_Initialize()

Dim I As Integer

With Me
With .CmbControle
For I = 1 To 10
.AddItem I
Next I
'récupère les valeurs dans la base de registre dans le clé
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
.Value = CInt(GetSetting("FormulaireImpression", _
"Controles", "Nombre", 4))
End With
.TxtHautForm.Value = CInt(GetSetting("FormulaireImpression", _
"Form", "Hauteur", 100))
.ChkCacher.Value = CBool(GetSetting("FormulaireImpression", _
"Feuille", "Cacher", False))
End With

CreerControles

FeActive = ActiveSheet.Name

End Sub

Private Sub CmdImprimer_Click()

Dim I As Integer

'appelle la proc pour sélectionner les feuilles choisies
'et affiche la boîte d'impression en activant le bouton
'du menu "Fichier". Passe la variable "I" en référence pour
'savoir le nombre de feuilles sélectionnées
FeuillesSelect I

If I = 0 Then
MsgBox "Aucune feuille n'a été sélectionnée !"
Exit Sub
End If

Me.Hide

Application.CommandBars("Worksheet Menu Bar") _
.Controls("&Fichier").Controls("&Imprimer...").Execute

'cache à nouveau les feuilles qui l'étaient
On Error Resume Next
For I = 1 To UBound(TblCacher)
Worksheets(TblCacher(I)).Visible = False
Next I

'ré-active la feuille qui était sélectionnée
'à l'ouverture du formulaire
Worksheets(FeActive).Select (True)

Me.Show

End Sub

Private Sub CmdApercu_Click()

Dim I As Integer

'appelle la proc pour sélectionner les feuilles choisies
'et affiche l'aperçu en activant le bouton du menu "Fichier"
'passe la variable "I" en référence pour savoir le nombre
'de feuilles sélectionnées
FeuillesSelect I

If I = 0 Then
MsgBox "Aucune feuille n'a été sélectionnée !"
Exit Sub
End If

Me.Hide

Application.CommandBars("Worksheet Menu Bar") _
.Controls("&Fichier").Controls("&Aperçu avant impression").Execute

'cache à nouveau les feuilles qui l'étaient
On Error Resume Next
For I = 1 To UBound(TblCacher)
Worksheets(TblCacher(I)).Visible = False
Next I

'ré-active la feuille qui était sélectionnée
'à l'ouverture du formulaire
Worksheets(FeActive).Select (True)

Me.Show

End Sub

Private Sub CmbControle_Click()
'inscrit la valeur dans la base de registre dans la clé :
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
SaveSetting "FormulaireImpression", "Controles", "Nombre", _
Me.CmbControle.Value

CreerControles

End Sub

Private Sub TxtHautForm_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Hte As Integer
Dim Tempo As Integer

Tempo = CInt(GetSetting("FormulaireImpression", _
"Form", "Hauteur", 100))

On Error Resume Next
With Me.TxtHautForm
Hte = CInt(.Value)
'gère l'erreur si du texte a été saisie
If Err.Number = 13 And .Value <> "" Then
MsgBox "Seul des nombres peuvent être saisies !", _
vbExclamation, "Incompatibilité de type."
.Value = Tempo
Exit Sub
End If
If .Value <> "" Then
If Hte < 75 Then
MsgBox "Valeur trop petite pour un affichage correct " & _
"des cases à cocher dans le formulaire !" & vbCrLf & _
"La dimension minimale est 75", vbExclamation, "Valeur
insuffisante."
.Value = Tempo
Exit Sub
End If
'inscrit la valeur dans la base de registre dans la clé :
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
SaveSetting "FormulaireImpression", "Form", "Hauteur", CInt(.Value)
CreerControles
End If
End With
End Sub

Private Sub ChkCacher_Click()
'inscrit la valeur dans la base de registre dans la clé :
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
SaveSetting "FormulaireImpression", "Feuille", "Cacher", Me.ChkCacher.Value
CreerControles
End Sub

Private Sub CreerControles()
Dim Feuille As Worksheet
Dim CelNonVide As Range
Dim FeAfficher As Integer
Dim LForm As Integer
Dim Nombre As Integer, HauteurMax As Integer
Dim Haut As Integer, Gauche As Integer
Dim Cacher As Boolean

'récupère les valeurs dans la base de registre dans le clé
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
Nombre = CInt(GetSetting("FormulaireImpression", _
"Controles", "Nombre", 4))
HauteurMax = CInt(GetSetting("FormulaireImpression", _
"Form", "Hauteur", 100))
Cacher = CBool(GetSetting("FormulaireImpression", _
"Feuille", "Cacher", False))

Haut = ESPACE
Gauche = ESPACE
LForm = (LARGEUR * Nombre) + (ESPACE * Nombre)

'vide le cadre si une modif est faite le formulaire affiché
With Me.Cadre
.Controls.Clear
.ScrollBars = fmScrollBarsNone
End With

'recherche tout dabord si au moins une cellule n'est pas vide
'si la feuille est visible et si elle contient des données, la
'case est activée sinon elle est désactivée. Si on veux afficher
'les feuilles cachées (case cochée) effectue le même manoeuvre
'que pour les feuilles visibles
'"FeAfficher" sert à compter le nombre de cases à cochées qui vont
'être ajoutées pour permettre un réajustement de la hauteur
For Each Feuille In Worksheets
Set CelNonVide = Feuille.Cells.Find _
("*", Feuille.[A1], xlFormulas, , , xlPrevious)
If Feuille.Visible = True Then
FeAfficher = FeAfficher + 1
If CelNonVide Is Nothing Then
CreerCases Feuille.Name, Haut, Gauche, _
LForm, False, False, False
Else
CreerCases Feuille.Name, Haut, Gauche, _
LForm, False, False, True
End If
Else
If Me.ChkCacher.Value = True Then
FeAfficher = FeAfficher + 1
If CelNonVide Is Nothing Then
CreerCases Feuille.Name, Haut, Gauche, _
LForm, True, True, False
Else
CreerCases Feuille.Name, Haut, Gauche, _
LForm, True, True, True
End If
End If
End If
Next Feuille


'vérifie si il peut y avoir une ligne de cases
'à cocher inférieure au nombre défini et réajuste
'la dimension
If FeAfficher Mod Nombre <> 0 Then Haut = Haut + HAUTEUR + ESPACE

PositionDimensions LForm, Haut, HauteurMax, Nombre

Set Feuille = Nothing
Set CelNonVide = Nothing

End Sub
Sub CreerCases(NomFeuille As String, Haut As Integer, Gauche As Integer, _
LargeurForm As Integer, Gras As Boolean, Barrer As Boolean, _
Activer As Boolean)

Dim CaseACocher As MSForms.CheckBox
'crée les cases à cocher et les paramètres
Set CaseACocher = Me.Cadre.Controls.Add _
("Forms.CheckBox.1", _
"Chk" & NomFeuille)
With CaseACocher
.Left = Gauche
.Top = Haut
.Width = LARGEUR
.Height = HAUTEUR
.Caption = NomFeuille
.Enabled = Activer
With .Font
.Name = "Arial Narrow"
.Size = 8
.Strikethrough = Barrer
.Bold = Gras
End With
End With
'calcul du positionnement
If Gauche >= LargeurForm - (LARGEUR + ESPACE) Then
Gauche = ESPACE
Haut = Haut + (HAUTEUR + ESPACE)
Else
Gauche = Gauche + (LARGEUR + ESPACE)
Haut = Haut
End If

Set CaseACocher = Nothing

End Sub
Private Sub PositionDimensions(LargeurForm As Integer, Haut As Integer, _
HauteurMax As Integer, NBCtrl As Integer)

Dim TopCadre As Integer

'dimensionne le formulaire
'positionne et dimensionne
'les différents contrôles
With Me
.Width = LargeurForm + 5
.Height = Haut + ((HAUTEUR + (ESPACE * 2)) * 2)
.Caption = "Feuilles à imprimer."

'bouton "Imprimer"
With .CmdImprimer
.ControlTipText = "Imprimer"
.Top = 0
.Left = 0
.Height = DIM_BTN
.Width = DIM_BTN
.Caption = ""
'.Picture = LoadPicture("C:Dossier1Dossier2Image1.bmp")
.PicturePosition = fmPicturePositionAboveCenter
End With

'bouton "Aperçu"
With .CmdApercu
.ControlTipText = "Aperçu"
.Top = 0
.Left = DIM_BTN + ESP_BTN
.Height = DIM_BTN
.Width = DIM_BTN
.Caption = ""
'.Picture = LoadPicture("C:Dossier1Dossier2Image2.bmp")
.PicturePosition = fmPicturePositionAboveCenter
End With

'ComboBox pour le nombre de cases à cocher sur une ligne
With .CmbControle
.ControlTipText = "Nombre de contrôles sur la même ligne"
.Height = HT_BTN
.Width = LG_BTN
End With

'TextBox pour définir la hauteur du formulaire
With .TxtHautForm
.ControlTipText = "Hauteur du formulaire " & _
"(Appuyer sur Entrée pour redessiner le " & _
"formulaire ou quitter le contrôle)"
.Height = HT_BTN
.Width = LG_BTN
End With

'case à cocher pour afficher ou non les feuilles cachées
With .ChkCacher
.Height = HT_BTN
.Width = 115
.Caption = "Inclure les feuilles cachées"
End With

'positionne ces contrôles en fonction du nombre
'de cases à cocher qui seront sur la même ligne
Select Case NBCtrl
Case 1, 2
TopCadre = (HT_BTN + ESP_BTN) * 3
If NBCtrl = 1 Then
LargeurForm = LARGEUR + ESPACE + BARRE
Else
LargeurForm = ((LARGEUR + ESPACE) * 2) + BARRE
End If
With .CmbControle
.Top = 0
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .TxtHautForm
.Top = HT_BTN + ESP_BTN
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .ChkCacher
.Top = (HT_BTN * 2) + (ESP_BTN * 2)
.Left = 0
End With
Case 3
TopCadre = (HT_BTN + ESP_BTN) * 2
With .CmbControle
.Top = 0
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .TxtHautForm
.Top = HT_BTN + ESP_BTN
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .ChkCacher
.Top = 0
.Left = (DIM_BTN * 2) + LG_BTN + (ESP_BTN * 3)
End With
Case Else
TopCadre = DIM_BTN + ESP_BTN
With .CmbControle
.Top = 0
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .TxtHautForm
.Top = 0
.Left = (DIM_BTN * 2) + LG_BTN + (ESP_BTN * 3)
End With
With .ChkCacher
.Top = 0
.Left = ((DIM_BTN + LG_BTN) * 2) + (ESP_BTN * 4)
End With

End Select

'cadre contenant les cases à cocher
With .Cadre
.Top = TopCadre
.Left = 0
If Me.Height > HauteurMax Then
Me.Height = HauteurMax
.ScrollBars = fmScrollBarsVertical
.ScrollHeight = Haut
.Height = HauteurMax - (TopCadre + 18)
.Width = LargeurForm + BARRE
Me.Width = LargeurForm + (BARRE + 3)
Else
.Height = Me.Height - (TopCadre + 18)
.Width = LargeurForm
End If
End With

'centre le formulaire sur l'écran
.Top = ((GetSystemMetrics(HT_ECRAN) * 0.75) / 2) - (.Height / 2)
.Left = ((GetSystemMetrics(LG_ECRAN) * 0.75) / 2) - (.Width / 2)
End With

End Sub

Sub FeuillesSelect(NBSelect As Integer)
Dim Ctrl As Control
Dim Sel As Boolean
Dim Cacher As Boolean
Dim I As Integer

'récupère la valeur dans la base de registre dans le clé
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
Cacher = CBool(GetSetting("FormulaireImpression", _
"Feuille", "Cacher", False))

For Each Ctrl In Me.Cadre.Controls
'si la case à cocher est true
If Ctrl.Value = True Then
'totalise le nombre de pages sélectionnées
'(la valeur de I est passée par référence
'et modifiée par NBSelect)
NBSelect = NBSelect + 1
With Worksheets(Ctrl.Caption)
'dé-sélectionne la feuille active du classeur
'au moment de l'ouverture du formulaire
If Sel = False Then
'si la feuille est une feuille cachée, et si
'la case est cochée, récupère le nom de la feuille
'afin de la re-cacher plus tard et la rend visible
'afin de permettre sa sélection pour l'impression
If Cacher = True And .Visible = False Then
I = I + 1
ReDim Preserve TblCacher(1 To I)
TblCacher(I) = Ctrl.Caption
.Visible = True
End If
.Select (True)
'une fois la feuille active dé-sélectionnée et la
'1ère feuille sélectionnée, autorise la sélection multiple
Sel = True
End If
If Cacher = True And .Visible = False Then
I = I + 1
ReDim Preserve TblCacher(1 To I)
TblCacher(I) = Ctrl.Caption
.Visible = True
End If
.Select (False)
End With
End If
Next
Set Ctrl = Nothing
End Sub
'-------------------------------------------------------------
Dans un module standard le code ci-dessous :
'------------------------------------------
Sub Afficher_FormImprimer()
UserForm1.Show
End Sub
'------------------------------------------
Et dans le module du ThisWorkbook, le code ci-dessous :
'------------------------------------------
Private Sub Workbook_Open()
Dim Btn As CommandBarButton
On Error Resume Next
With Application.CommandBars("Worksheet Menu Bar")
.Controls("MonBouton").Delete
Set Btn = .Controls.Add(msoControlButton)
With Btn
.Caption = "MonBouton"
.OnAction = "Afficher_FormImprimer"
.TooltipText = "Formulaire d'impression"
.FaceId = 364
End With
End With
Set Btn = Nothing
End Sub

Private Sub Workbook_Activate()
On Error Resume Next
With Application.CommandBars("Worksheet Menu Bar")
.Controls("MonBouton").Visible = True
End With
End Sub

Private Sub Workbook_Deactivate()
On Error Resume Next
With Application.CommandBars("Worksheet Menu Bar")
.Controls("MonBouton").Visible = False
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
With Application.CommandBars("Worksheet Menu Bar")
.Controls("MonBouton").Delete
End With
End Sub
'---------------------------------------------

Pour tester tu exécute la proc "Workbook_Open" (à partir du VBE pour ne pas
à avoir à fermer puis réouvrir le calsseur) afin de créer le bouton d'appel
de la form. Cette dernière se positionne au centre de l'écran, place et
dimensionne les contrôles (place les n'importe où sur ta form, ça na pas
d'importance seul leur nom a de l'importance) et elle construit les cases à
cocher en fonction du nombre de feuilles. Il t'es possible de définir le
nombre de cases à cocher par ligne et la hauteur de la form, pour ça tu
utilise le combobox pour le nombre de cases et le textbox pour la hauteur.
La case à cocher "Inclure les feuilles cachées" comme elle l'indique te
permets d'inclure les feuilles qui sont cacher afin de pouvoir les imprimer
sans être forcé de les rendre visibles.

En espérant que ceci te conviendra. Si tu n'y arrive pas, fais le savoir je
t'enverrai un classeur en exemple.

Hervé.


"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 3D3A1A39-9EE1-48C2-9BED-C72843E2E02F@microsoft.com...

Bonjour à vous tous,
encore merci à vous d'aidez les débutants en Excel, ou ceux qui veulent
faire plus qu'ils ne peuvent....
J'ai pas eu de succès pour mon problème de combobox pour imprimer.
Alors je pensais à autre chose :
-est-il possible d'insérer, dans ma barre d'outil personnelle, une liste
de
choix qui déclencheront des macros ??

Je vous remercie.

YANN

Salut,
merci pour ton code, c'est un truc de pro ça !!!
Alors, par contre, j'ai un peu de mal sur le cadre.
En fait, je ne vois que peu les boutons "Imprimer" et "Aperçu".
de plus, j'ai une cinquantaine d'onglets, mais leur nom est assez court (5
caractères au max), donc est-il possible d'avoir 7 ou choix par ligne ?
Et peut-on faire un choix qui regroupe plusieurs onglets ? je m'explique.
C'est un dossier de travail que je crée.
En choix d'impression, je voudrais avoir un choix d'impression par cycle
En fait, si j'imprime la feuille 10, je veux par conséquent imprimer la
10.21, la 10.31 et la 10.41 en même temps. (avec une condition, qui je pense
est complexe, je verrais ultérieurement)
et celà de manière un eu identique quand j'imprime la feuille 20.
Merci de votre aide.
YANN

"Hervé" a écrit :

Bonsoir Sunburn,
Surtout ne t'affole pas en voyant le code, suit simplement mes directives.
Sur une form tu pose (n'importe où et de n'importe quelle façon) :
- 1 CommandButton que tu nomme "CmdImprimer"
- 1 CommandButton que tu nomme "CmdApercu"
- 1 Frame que tu nomme "Cadre"
- 1 TextBox que tu nomme "TxtHautForm"
- 1 ComboBox que tu nomme "CmbControle"
- 1 CheckBox que tu nomme "ChkCacher" et que tu titre "Inclure les feuilles
cachées"
Puis dans le module de la Form, tout ce code (des pointillés aux pointillés
suivants, je l'ai je pense assez bien commenté pour plus de compréhension) :
'--------------------------------------------------
'API pour récupérer les dimensions de l'écran
'pour le centrage du formulaire
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

'Constantes pour le centrage du formulaire
Private Const LG_ECRAN = 0
Private Const HT_ECRAN = 1

'nom de la feuille active (pour la réactiver)
'tableau pour les feuilles cachées
Dim FeActive As String
Dim TblCacher() As String

'Constantes pour le dimenssionnement des contrôles
Const ESP_BTN As Integer = 2
Const LARGEUR As Integer = 70
Const HAUTEUR As Integer = 15
Const ESPACE As Integer = 6
Const DIM_BTN As Integer = 20
Const LG_BTN As Integer = 40
Const HT_BTN As Integer = 15
Const BARRE As Integer = 16

Private Sub UserForm_Initialize()

Dim I As Integer

With Me
With .CmbControle
For I = 1 To 10
.AddItem I
Next I
'récupère les valeurs dans la base de registre dans le clé
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
.Value = CInt(GetSetting("FormulaireImpression", _
"Controles", "Nombre", 4))
End With
.TxtHautForm.Value = CInt(GetSetting("FormulaireImpression", _
"Form", "Hauteur", 100))
.ChkCacher.Value = CBool(GetSetting("FormulaireImpression", _
"Feuille", "Cacher", False))
End With

CreerControles

FeActive = ActiveSheet.Name

End Sub

Private Sub CmdImprimer_Click()

Dim I As Integer

'appelle la proc pour sélectionner les feuilles choisies
'et affiche la boîte d'impression en activant le bouton
'du menu "Fichier". Passe la variable "I" en référence pour
'savoir le nombre de feuilles sélectionnées
FeuillesSelect I

If I = 0 Then
MsgBox "Aucune feuille n'a été sélectionnée !"
Exit Sub
End If

Me.Hide

Application.CommandBars("Worksheet Menu Bar") _
.Controls("&Fichier").Controls("&Imprimer...").Execute

'cache à nouveau les feuilles qui l'étaient
On Error Resume Next
For I = 1 To UBound(TblCacher)
Worksheets(TblCacher(I)).Visible = False
Next I

'ré-active la feuille qui était sélectionnée
'à l'ouverture du formulaire
Worksheets(FeActive).Select (True)

Me.Show

End Sub

Private Sub CmdApercu_Click()

Dim I As Integer

'appelle la proc pour sélectionner les feuilles choisies
'et affiche l'aperçu en activant le bouton du menu "Fichier"
'passe la variable "I" en référence pour savoir le nombre
'de feuilles sélectionnées
FeuillesSelect I

If I = 0 Then
MsgBox "Aucune feuille n'a été sélectionnée !"
Exit Sub
End If

Me.Hide

Application.CommandBars("Worksheet Menu Bar") _
.Controls("&Fichier").Controls("&Aperçu avant impression").Execute

'cache à nouveau les feuilles qui l'étaient
On Error Resume Next
For I = 1 To UBound(TblCacher)
Worksheets(TblCacher(I)).Visible = False
Next I

'ré-active la feuille qui était sélectionnée
'à l'ouverture du formulaire
Worksheets(FeActive).Select (True)

Me.Show

End Sub

Private Sub CmbControle_Click()
'inscrit la valeur dans la base de registre dans la clé :
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
SaveSetting "FormulaireImpression", "Controles", "Nombre", _
Me.CmbControle.Value

CreerControles

End Sub

Private Sub TxtHautForm_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Hte As Integer
Dim Tempo As Integer

Tempo = CInt(GetSetting("FormulaireImpression", _
"Form", "Hauteur", 100))

On Error Resume Next
With Me.TxtHautForm
Hte = CInt(.Value)
'gère l'erreur si du texte a été saisie
If Err.Number = 13 And .Value <> "" Then
MsgBox "Seul des nombres peuvent être saisies !", _
vbExclamation, "Incompatibilité de type."
.Value = Tempo
Exit Sub
End If
If .Value <> "" Then
If Hte < 75 Then
MsgBox "Valeur trop petite pour un affichage correct " & _
"des cases à cocher dans le formulaire !" & vbCrLf & _
"La dimension minimale est 75", vbExclamation, "Valeur
insuffisante."
.Value = Tempo
Exit Sub
End If
'inscrit la valeur dans la base de registre dans la clé :
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
SaveSetting "FormulaireImpression", "Form", "Hauteur", CInt(.Value)
CreerControles
End If
End With
End Sub

Private Sub ChkCacher_Click()
'inscrit la valeur dans la base de registre dans la clé :
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
SaveSetting "FormulaireImpression", "Feuille", "Cacher", Me.ChkCacher.Value
CreerControles
End Sub

Private Sub CreerControles()
Dim Feuille As Worksheet
Dim CelNonVide As Range
Dim FeAfficher As Integer
Dim LForm As Integer
Dim Nombre As Integer, HauteurMax As Integer
Dim Haut As Integer, Gauche As Integer
Dim Cacher As Boolean

'récupère les valeurs dans la base de registre dans le clé
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
Nombre = CInt(GetSetting("FormulaireImpression", _
"Controles", "Nombre", 4))
HauteurMax = CInt(GetSetting("FormulaireImpression", _
"Form", "Hauteur", 100))
Cacher = CBool(GetSetting("FormulaireImpression", _
"Feuille", "Cacher", False))

Haut = ESPACE
Gauche = ESPACE
LForm = (LARGEUR * Nombre) + (ESPACE * Nombre)

'vide le cadre si une modif est faite le formulaire affiché
With Me.Cadre
.Controls.Clear
.ScrollBars = fmScrollBarsNone
End With

'recherche tout dabord si au moins une cellule n'est pas vide
'si la feuille est visible et si elle contient des données, la
'case est activée sinon elle est désactivée. Si on veux afficher
'les feuilles cachées (case cochée) effectue le même manoeuvre
'que pour les feuilles visibles
'"FeAfficher" sert à compter le nombre de cases à cochées qui vont
'être ajoutées pour permettre un réajustement de la hauteur
For Each Feuille In Worksheets
Set CelNonVide = Feuille.Cells.Find _
("*", Feuille.[A1], xlFormulas, , , xlPrevious)
If Feuille.Visible = True Then
FeAfficher = FeAfficher + 1
If CelNonVide Is Nothing Then
CreerCases Feuille.Name, Haut, Gauche, _
LForm, False, False, False
Else
CreerCases Feuille.Name, Haut, Gauche, _
LForm, False, False, True
End If
Else
If Me.ChkCacher.Value = True Then
FeAfficher = FeAfficher + 1
If CelNonVide Is Nothing Then
CreerCases Feuille.Name, Haut, Gauche, _
LForm, True, True, False
Else
CreerCases Feuille.Name, Haut, Gauche, _
LForm, True, True, True
End If
End If
End If
Next Feuille


'vérifie si il peut y avoir une ligne de cases
'à cocher inférieure au nombre défini et réajuste
'la dimension
If FeAfficher Mod Nombre <> 0 Then Haut = Haut + HAUTEUR + ESPACE

PositionDimensions LForm, Haut, HauteurMax, Nombre

Set Feuille = Nothing
Set CelNonVide = Nothing

End Sub
Sub CreerCases(NomFeuille As String, Haut As Integer, Gauche As Integer, _
LargeurForm As Integer, Gras As Boolean, Barrer As Boolean, _
Activer As Boolean)

Dim CaseACocher As MSForms.CheckBox
'crée les cases à cocher et les paramètres
Set CaseACocher = Me.Cadre.Controls.Add _
("Forms.CheckBox.1", _
"Chk" & NomFeuille)
With CaseACocher
.Left = Gauche
.Top = Haut
.Width = LARGEUR
.Height = HAUTEUR
.Caption = NomFeuille
.Enabled = Activer
With .Font
.Name = "Arial Narrow"
.Size = 8
.Strikethrough = Barrer
.Bold = Gras
End With
End With
'calcul du positionnement
If Gauche >= LargeurForm - (LARGEUR + ESPACE) Then
Gauche = ESPACE
Haut = Haut + (HAUTEUR + ESPACE)
Else
Gauche = Gauche + (LARGEUR + ESPACE)
Haut = Haut
End If

Set CaseACocher = Nothing

End Sub
Private Sub PositionDimensions(LargeurForm As Integer, Haut As Integer, _
HauteurMax As Integer, NBCtrl As Integer)

Dim TopCadre As Integer

Bonsoir Sunburn,
Pour ce qui est des boutons, j'ai oublier de coller les images dessus donc
remplace toute la proc "PositionDimensions" par la nouvelle ci-dessous (plus
facile que de t'expliquer où placer les différentes lignes).
Si tu veux 7 feuilles par ligne, il te suffit de choisir 7 dans le combobox.
Maintenant, en ce qui concerne ton regroupement d'onglet il faut écrire une
routine pour faire ce que tu désire.
J'ai écris cet ensemble de procédures il y a environ 3 ans pour un boulot à
cette époque mais plus utilisé maintenant et il y a quelques valeurs en
"dur" qu'il faut virer pour rendre le classeur plus souple mais je n'ai pas
trop de temps pour plancher là dessus.

Private Sub PositionDimensions(LargeurForm As Integer, Haut As Integer, _
HauteurMax As Integer, NBCtrl As Integer)

Dim Btn As CommandBarButton
Dim TopCadre As Integer

'dimensionne le formulaire
'positionne et dimensionne
'les différents contrôles
With Me
.Width = LargeurForm + 5
.Height = Haut + ((HAUTEUR + (ESPACE * 2)) * 2)
.Caption = "Feuilles à imprimer."

'bouton "Imprimer"
With .CmdImprimer
.ControlTipText = "Imprimer"
.Top = 0
.Left = 0
.Height = DIM_BTN
.Width = DIM_BTN
.Caption = ""
Set Btn = CommandBars.FindControl(msoControlButton, 2521)
.Picture = Btn.Picture
.PicturePosition = fmPicturePositionAboveCenter
End With

'bouton "Aperçu"
With .CmdApercu
.ControlTipText = "Aperçu"
.Top = 0
.Left = DIM_BTN + ESP_BTN
.Height = DIM_BTN
.Width = DIM_BTN
.Caption = ""
Set Btn = CommandBars.FindControl(msoControlButton, 109)
.Picture = Btn.Picture
.PicturePosition = fmPicturePositionAboveCenter
End With

'ComboBox pour le nombre de cases à cocher sur une ligne
With .CmbControle
.ControlTipText = "Nombre de contrôles sur la même ligne"
.Height = HT_BTN
.Width = LG_BTN
End With

'TextBox pour définir la hauteur du formulaire
With .TxtHautForm
.ControlTipText = "Hauteur du formulaire " & _
"(Appuyer sur Entrée pour redessiner le " & _
"formulaire ou quitter le contrôle)"
.Height = HT_BTN
.Width = LG_BTN
End With

'case à cocher pour afficher ou non les feuilles cachées
With .ChkCacher
.Height = HT_BTN
.Width = 115
.Caption = "Inclure les feuilles cachées"
End With

'positionne ces contrôles en fonction du nombre
'de cases à cocher qui seront sur la même ligne
Select Case NBCtrl
Case 1, 2
TopCadre = (HT_BTN + ESP_BTN) * 3
If NBCtrl = 1 Then
LargeurForm = LARGEUR + ESPACE + BARRE
Else
LargeurForm = ((LARGEUR + ESPACE) * 2) + BARRE
End If
With .CmbControle
.Top = 0
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .TxtHautForm
.Top = HT_BTN + ESP_BTN
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .ChkCacher
.Top = (HT_BTN * 2) + (ESP_BTN * 2)
.Left = 0
End With
Case 3
TopCadre = (HT_BTN + ESP_BTN) * 2
With .CmbControle
.Top = 0
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .TxtHautForm
.Top = HT_BTN + ESP_BTN
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .ChkCacher
.Top = 0
.Left = (DIM_BTN * 2) + LG_BTN + (ESP_BTN * 3)
End With
Case Else
TopCadre = DIM_BTN + ESP_BTN
With .CmbControle
.Top = 0
.Left = (DIM_BTN + ESP_BTN) * 2
End With
With .TxtHautForm
.Top = 0
.Left = (DIM_BTN * 2) + LG_BTN + (ESP_BTN * 3)
End With
With .ChkCacher
.Top = 0
.Left = ((DIM_BTN + LG_BTN) * 2) + (ESP_BTN * 4)
End With

End Select

'cadre contenant les cases à cocher
With .Cadre
.Top = TopCadre
.Left = 0
If Me.Height > HauteurMax Then
Me.Height = HauteurMax
.ScrollBars = fmScrollBarsVertical
.ScrollHeight = Haut
.Height = HauteurMax - (TopCadre + 18)
.Width = LargeurForm + BARRE
Me.Width = LargeurForm + (BARRE + 3)
Else
.Height = Me.Height - (TopCadre + 18)
.Width = LargeurForm
End If
End With

'centre le formulaire sur l'écran
.Top = ((GetSystemMetrics(HT_ECRAN) * 0.75) / 2) - (.Height / 2)
.Left = ((GetSystemMetrics(LG_ECRAN) * 0.75) / 2) - (.Width / 2)
End With

End Sub

Hervé


"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: AABAA097-4D90-462D-A05B-DA4449ED47C6@microsoft.com...

Salut,
merci pour ton code, c'est un truc de pro ça !!!
Alors, par contre, j'ai un peu de mal sur le cadre.
En fait, je ne vois que peu les boutons "Imprimer" et "Aperçu".
de plus, j'ai une cinquantaine d'onglets, mais leur nom est assez court (5
caractères au max), donc est-il possible d'avoir 7 ou choix par ligne ?
Et peut-on faire un choix qui regroupe plusieurs onglets ? je m'explique.
C'est un dossier de travail que je crée.
En choix d'impression, je voudrais avoir un choix d'impression par cycle
En fait, si j'imprime la feuille 10, je veux par conséquent imprimer la
10.21, la 10.31 et la 10.41 en même temps. (avec une condition, qui je
pense
est complexe, je verrais ultérieurement)
et celà de manière un eu identique quand j'imprime la feuille 20.
Merci de votre aide.
YANN

"Hervé" a écrit :

Bonsoir Sunburn,
Surtout ne t'affole pas en voyant le code, suit simplement mes
directives.
Sur une form tu pose (n'importe où et de n'importe quelle façon) :
- 1 CommandButton que tu nomme "CmdImprimer"
- 1 CommandButton que tu nomme "CmdApercu"
- 1 Frame que tu nomme "Cadre"
- 1 TextBox que tu nomme "TxtHautForm"
- 1 ComboBox que tu nomme "CmbControle"
- 1 CheckBox que tu nomme "ChkCacher" et que tu titre "Inclure les
feuilles
cachées"
Puis dans le module de la Form, tout ce code (des pointillés aux
pointillés
suivants, je l'ai je pense assez bien commenté pour plus de
compréhension) :
'--------------------------------------------------
'API pour récupérer les dimensions de l'écran
'pour le centrage du formulaire
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

'Constantes pour le centrage du formulaire
Private Const LG_ECRAN = 0
Private Const HT_ECRAN = 1

'nom de la feuille active (pour la réactiver)
'tableau pour les feuilles cachées
Dim FeActive As String
Dim TblCacher() As String

'Constantes pour le dimenssionnement des contrôles
Const ESP_BTN As Integer = 2
Const LARGEUR As Integer = 70
Const HAUTEUR As Integer = 15
Const ESPACE As Integer = 6
Const DIM_BTN As Integer = 20
Const LG_BTN As Integer = 40
Const HT_BTN As Integer = 15
Const BARRE As Integer = 16

Private Sub UserForm_Initialize()

Dim I As Integer

With Me
With .CmbControle
For I = 1 To 10
.AddItem I
Next I
'récupère les valeurs dans la base de registre dans le clé
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
.Value = CInt(GetSetting("FormulaireImpression", _
"Controles", "Nombre", 4))
End With
.TxtHautForm.Value = CInt(GetSetting("FormulaireImpression", _
"Form", "Hauteur", 100))
.ChkCacher.Value = CBool(GetSetting("FormulaireImpression", _
"Feuille", "Cacher", False))
End With

CreerControles

FeActive = ActiveSheet.Name

End Sub

Private Sub CmdImprimer_Click()

Dim I As Integer

'appelle la proc pour sélectionner les feuilles choisies
'et affiche la boîte d'impression en activant le bouton
'du menu "Fichier". Passe la variable "I" en référence pour
'savoir le nombre de feuilles sélectionnées
FeuillesSelect I

If I = 0 Then
MsgBox "Aucune feuille n'a été sélectionnée !"
Exit Sub
End If

Me.Hide

Application.CommandBars("Worksheet Menu Bar") _
.Controls("&Fichier").Controls("&Imprimer...").Execute

'cache à nouveau les feuilles qui l'étaient
On Error Resume Next
For I = 1 To UBound(TblCacher)
Worksheets(TblCacher(I)).Visible = False
Next I

'ré-active la feuille qui était sélectionnée
'à l'ouverture du formulaire
Worksheets(FeActive).Select (True)

Me.Show

End Sub

Private Sub CmdApercu_Click()

Dim I As Integer

'appelle la proc pour sélectionner les feuilles choisies
'et affiche l'aperçu en activant le bouton du menu "Fichier"
'passe la variable "I" en référence pour savoir le nombre
'de feuilles sélectionnées
FeuillesSelect I

If I = 0 Then
MsgBox "Aucune feuille n'a été sélectionnée !"
Exit Sub
End If

Me.Hide

Application.CommandBars("Worksheet Menu Bar") _
.Controls("&Fichier").Controls("&Aperçu avant impression").Execute

'cache à nouveau les feuilles qui l'étaient
On Error Resume Next
For I = 1 To UBound(TblCacher)
Worksheets(TblCacher(I)).Visible = False
Next I

'ré-active la feuille qui était sélectionnée
'à l'ouverture du formulaire
Worksheets(FeActive).Select (True)

Me.Show

End Sub

Private Sub CmbControle_Click()
'inscrit la valeur dans la base de registre dans la clé :
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
SaveSetting "FormulaireImpression", "Controles", "Nombre", _
Me.CmbControle.Value

CreerControles

End Sub

Private Sub TxtHautForm_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Hte As Integer
Dim Tempo As Integer

Tempo = CInt(GetSetting("FormulaireImpression", _
"Form", "Hauteur", 100))

On Error Resume Next
With Me.TxtHautForm
Hte = CInt(.Value)
'gère l'erreur si du texte a été saisie
If Err.Number = 13 And .Value <> "" Then
MsgBox "Seul des nombres peuvent être saisies !", _
vbExclamation, "Incompatibilité de type."
.Value = Tempo
Exit Sub
End If
If .Value <> "" Then
If Hte < 75 Then
MsgBox "Valeur trop petite pour un affichage correct " & _
"des cases à cocher dans le formulaire !" & vbCrLf & _
"La dimension minimale est 75", vbExclamation, "Valeur
insuffisante."
.Value = Tempo
Exit Sub
End If
'inscrit la valeur dans la base de registre dans la clé :
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
SaveSetting "FormulaireImpression", "Form", "Hauteur",
CInt(.Value)
CreerControles
End If
End With
End Sub

Private Sub ChkCacher_Click()
'inscrit la valeur dans la base de registre dans la clé :
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
SaveSetting "FormulaireImpression", "Feuille", "Cacher",
Me.ChkCacher.Value
CreerControles
End Sub

Private Sub CreerControles()
Dim Feuille As Worksheet
Dim CelNonVide As Range
Dim FeAfficher As Integer
Dim LForm As Integer
Dim Nombre As Integer, HauteurMax As Integer
Dim Haut As Integer, Gauche As Integer
Dim Cacher As Boolean

'récupère les valeurs dans la base de registre dans le clé
'HKEY_CURRENT_USERSoftwareVB and VBA Program
SettingsFormulaireImpression
Nombre = CInt(GetSetting("FormulaireImpression", _
"Controles", "Nombre", 4))
HauteurMax = CInt(GetSetting("FormulaireImpression", _
"Form", "Hauteur", 100))
Cacher = CBool(GetSetting("FormulaireImpression", _
"Feuille", "Cacher", False))

Haut = ESPACE
Gauche = ESPACE
LForm = (LARGEUR * Nombre) + (ESPACE * Nombre)

'vide le cadre si une modif est faite le formulaire affiché
With Me.Cadre
.Controls.Clear
.ScrollBars = fmScrollBarsNone
End With

'recherche tout dabord si au moins une cellule n'est pas vide
'si la feuille est visible et si elle contient des données, la
'case est activée sinon elle est désactivée. Si on veux afficher
'les feuilles cachées (case cochée) effectue le même manoeuvre
'que pour les feuilles visibles
'"FeAfficher" sert à compter le nombre de cases à cochées qui
vont
'être ajoutées pour permettre un réajustement de la hauteur
For Each Feuille In Worksheets
Set CelNonVide = Feuille.Cells.Find _
("*", Feuille.[A1], xlFormulas, , , xlPrevious)
If Feuille.Visible = True Then
FeAfficher = FeAfficher + 1
If CelNonVide Is Nothing Then
CreerCases Feuille.Name, Haut, Gauche, _
LForm, False, False, False
Else
CreerCases Feuille.Name, Haut, Gauche, _
LForm, False, False, True
End If
Else
If Me.ChkCacher.Value = True Then
FeAfficher = FeAfficher + 1
If CelNonVide Is Nothing Then
CreerCases Feuille.Name, Haut, Gauche, _
LForm, True, True, False
Else
CreerCases Feuille.Name, Haut, Gauche, _
LForm, True, True, True
End If
End If
End If
Next Feuille


'vérifie si il peut y avoir une ligne de cases
'à cocher inférieure au nombre défini et réajuste
'la dimension
If FeAfficher Mod Nombre <> 0 Then Haut = Haut + HAUTEUR + ESPACE

PositionDimensions LForm, Haut, HauteurMax, Nombre

Set Feuille = Nothing
Set CelNonVide = Nothing

End Sub
Sub CreerCases(NomFeuille As String, Haut As Integer, Gauche As Integer,
_
LargeurForm As Integer, Gras As Boolean, Barrer As
Boolean, _
Activer As Boolean)

Dim CaseACocher As MSForms.CheckBox
'crée les cases à cocher et les paramètres
Set CaseACocher = Me.Cadre.Controls.Add _
("Forms.CheckBox.1", _
"Chk" & NomFeuille)
With CaseACocher
.Left = Gauche
.Top = Haut
.Width = LARGEUR
.Height = HAUTEUR
.Caption = NomFeuille
.Enabled = Activer
With .Font
.Name = "Arial Narrow"
.Size = 8
.Strikethrough = Barrer
.Bold = Gras
End With
End With
'calcul du positionnement
If Gauche >= LargeurForm - (LARGEUR + ESPACE) Then
Gauche = ESPACE
Haut = Haut + (HAUTEUR + ESPACE)
Else
Gauche = Gauche + (LARGEUR + ESPACE)
Haut = Haut
End If

Set CaseACocher = Nothing

End Sub
Private Sub PositionDimensions(LargeurForm As Integer, Haut As Integer, _
HauteurMax As Integer, NBCtrl As Integer)

Dim TopCadre As Integer

Bonjour Hervé,
Merci, les icônes sont là...
Pour le nombre de case à cocher (j'en voudrais 7), et l'espace entre chaque
case peut être réduit, mais je n'arrive pas à trouver ce que je veux.
De plus, si je défini 7 cases côte à côte, je n'ai plus besoin d'avoir le
choix d'affichage.
Mais j'ai du mal dans le code, et je ne sais pas quoi enlever et modifier,
car il y a des tailles et des valeurs pour tout. Donc si tu peux encore
m'aider, ça serait super cool.
Merci.

Re,
une autre question, en fait, c'est l'emplacement de ce bouton "imprimer".
Je voudrais qu'il soit intégré à ma barre d'outil perso, car je supprime les
menus Excel et les barres d'outil Excel à l'ouverture de mon fichier.
Comment faire ?
Voilà le code de ma barre d'outil si besoin. (les boutons sont des boutons
d'affichage uniquement, des macros simples pour afficher des pages voulues).
Merci. YANN
------
Sub auto_open()
SUPPRIMERMENUS 'macro pour supprimer les menus
DESACTIVERACCOURCIS 'macro pour supprimer les raccourcis
Set vmabarre = CommandBars.Add(Name:="barremacro", Position:=msoBarTop,
temporary:úlse)
vmabarre.Visible = True
Set newbouton1 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton1
.Caption = "Tout le dossier"
.FaceId = 59 'image
.BeginGroup = True
.OnAction = "TOUT"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Général"
End With
'pour avoir un traite de séparation entre les boutons 1 et 2
BeginGroup = True
Set newbouton2 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton2
.Caption = "Dossier Général"
.FaceId = 287 'image
.BeginGroup = True
.OnAction = "DGA"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Dossier Général"
End With
Set newbouton3 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton3
.Caption = "Dossier de Contrôle"
.FaceId = 172 'image
.BeginGroup = True
.OnAction = "DCA"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Régularité Formelle"
End With
Set newbouton4 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton4
.Caption = "Cycle 10"
.FaceId = 71 'image
.BeginGroup = True
.OnAction = "CYCLE10"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Cycle 10"
End With
Set newbouton5 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton5
.Caption = "Cycle 20"
.FaceId = 72 'image
.BeginGroup = True
.OnAction = "CYCLE20"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Cycle 20"
End With
Set newbouton6 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton6
.Caption = "Cycle 30"
.FaceId = 73 'image
.BeginGroup = True
.OnAction = "CYCLE30"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Cycle 30"
End With
Set newbouton7 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton7
.Caption = "Cycle 40"
.FaceId = 74 'image
.BeginGroup = True
.OnAction = "CYCLE40"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Cycle 40"
End With
Set newbouton8 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton8
.Caption = "Cycle 50"
.FaceId = 75 'image
.BeginGroup = True
.OnAction = "CYCLE50"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Cycle 50"
End With
Set newbouton9 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton9
.Caption = "Cycle 60"
.FaceId = 76 'image
.BeginGroup = True
.OnAction = "CYCLE60"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Cycle 60"
End With
Set newbouton10 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton10
.Caption = "Cycle 70"
.FaceId = 77 'image
.BeginGroup = True
.OnAction = "CYCLE70"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Cycle 70"
End With
Set newbouton11 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton11
.Caption = "Cycle 80"
.FaceId = 78 'image
.BeginGroup = True
.OnAction = "CYCLE80"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Cycle 80"
End With
Set newbouton12 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton12
.Caption = "Cycle 90"
.FaceId = 79 'image
.BeginGroup = True
.OnAction = "CYCLE90"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Cycle 90"
End With
Set newbouton13 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton13
.Caption = "Pages de Garde"
.FaceId = 139 'image
.BeginGroup = True
.OnAction = "PAGEDEGARDE"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Pages de Garde"
End With
Set newbouton14 =
CommandBars("barremacro").Controls.Add(Type:=msoControlButton)
With newbouton14
.Caption = "Fiches suiv."
.FaceId = 19 'image
.BeginGroup = True
.OnAction = "FICHES"
.Style = msoButtonIconAndCaptionBelow
.TooltipText = "Fiches suiveuses"
End With
End Sub
------