Créer Checkbox avec un resultat qui lance une autre macro

[Lathoure]

Bonjour
Voici mes besoins:
J'ai 10 macros qui mettre en page des feuilles et les imprimes. (ex:BT, AT, EXE, AT2, EXE2 etc)
Mon doc excel s'ouvre jamais avec les memes feuilles. (par exemple BT +AT ou BT+EXE ou BT+EXE+AT)
je voudrais creer une checkbox qui me donne toute les feuilles presente sur mon Fichier
(jusque la j'ai trouver une macro qui me le fait c'est nickel)
mais le soucis que j'ai, c'est que cette macro m'imprime une feuille par une et ne va pas chercher mes autres macro.
Pour faire simple voici la macro pour la checkbox de toute les feuilles:
Sub SelectSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Application.ScreenUpdating = False

' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0

' Add the checkboxes

TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Skip empty sheets and hidden sheets
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i

' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Select sheets to print"

End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging

End If
Next cb
End If
Else
MsgBox "All worksheets are empty."
End If

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete

' Reactivate original sheet
CurrentSheet.Activate
End Sub


Mais ce que je veut c'est que si je sellectionne les feuilles BT_GAZ et AT_GAZ, il mùelance cette macro

Sheets("BT_GAZ").Select
Range("CA18:CM19").Select
Selection.ClearContents
withrépertoirePhoto = "C:\Users\e21253\Images\LOTUS\Signature BT" ' Adapter
Nom = "droc"
Set c = Range("CA18").MergeArea
With ActiveSheet
.Pictures.Insert("C:\Users\e21253\Images\LOTUS\Signature BT\sign.png").Name = Nom
.Shapes(Nom).Left = c.Left
.Shapes(Nom).Top = c.Top
.Shapes(Nom).LockAspectRatio = msoFalse
.Shapes(Nom).Height = c.Height
.Shapes(Nom).Width = c.Width
End With
With Sheets("BT_GAZ").PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.ScaleWithDocHeaderFooter = True
End With
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("AT_GAZ").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$U$43"
With Sheets("AT_GAZ").PageSetup
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintQuality = 600
.Orientation = xlLandscape
.PaperSize = xlPaperA3
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.ScaleWithDocHeaderFooter = True
End With
Sheets("BT_GAZ").Select
Sheets(Array("BT_GAZ", "AT_GAZ")).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub



je ne sais pas si j'ai été trés clair?

 

[Staple1600]

Re : Créer Checkbox avec un resultat qui lance une autre macro

Re

(jusque la j'ai trouver une macro qui me le fait c'est nickel)

Tu es sur que c'est je qu'il faut écrire...je ne t'aurai pas un peu aidé par hasard

Lathoure
Ça fait plaisir de voir que tu cites ton autre fil où on s'est croisé...
Comme cela fait plaisir de voir la trace du nom de l'auteur: John Walkenbach
(auteur du code que j'ai cité dans l'autre fil)
J'ai bien fait de te consacrer une palanquée de minutes

Pour un peu je serai comme qui dirait blasé...
Ah non c'est vrai, je déteste les blazers.

 

[Lathoure]

Re : Créer Checkbox avec un resultat qui lance une autre macro

Excuse moi Staple
Pour la suite de ce fil, et d'ailleurs ça pourrait peut etre aidé, je remercie Staple qui a largement contribué à la constructiuon de mes macros de mise en page et impression.
Il a fait un travail remarquable et m'a meme trouvé cette fabuleuse macro pour le checkbox de toute les feuille presente.

voir ce fil et vous comprendrez tout

https://www.excel-downloads.com/threads/probleme-impression-avec-macro3.212527/