macro pour imprimer une meme zone sur plusieurs onglets

[mix770]

Bonjour,
j'ai besoin d'un peu d'aide SVP, j'ai un classeur 52 onglets (nom 1,nom 2, etc) avec un tableau par mois par onglet (janv, fevr, etc).
j'ai une macro pour imprimer chaque zone:

Sub impression_janvier()
Range("A1:M46").Select
Selection.PrintOut
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Range("A1").Select
End Sub

mon problème est pour créer une macro pour une partie des onglets, de nom 1 à nom 40 et une autre pour les autres, j'ai une macro qui fonctionne pour toutes les feuilles mais les tableaux après nom 40 n'ont pas la même taille, donc ils sont coupé. J'ai essayé avec l'enregistreur de macro mais il n'imprime qu'une page, le code:

Private Sub imprime_Février_Click()
Dim Sh As Worksheet
Application.ScreenUpdating = True
For Each Sh In Sheets
If Sh.Name <> "Accueil Service continu" Then
Sh.PageSetup.PrintArea = "$A$58:$M$103"
Sh.Select False
Application.ActivePrinter = "PDFCreator sur Ne00:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"PDFCreator sur Ne00:", Collate:=True
Sheets("Accueil Service continu").Select
Unload Me
End Sub

si quelqu'un à une idée; merci beaucoup par avance
cordialement

 

[mix770]

Re : macro pour imprimer une meme zone sur plusieurs onglets

Bonjour,
personne à une idée ?

 

[Paf]

Re : macro pour imprimer une meme zone sur plusieurs onglets

Bonjour

si les feuilles sont dans l'ordre croissant de nom et leur ordre n'est pas modifié, une solution:

Récupérer l'index de la feuille "nom 40" et comparer, dans la boucle For Each Sh In Sheets avec l'index de la feuille traitée .

Num = Worksheets("nom 40").Index

puis dans la boucle For Each, après If Sh.Name <> "Accueil Service continu" Then :

If Sh.Index > Num then 
    Sh.PageSetup.PrintArea = "$Z$58:$W$103"   ' aire pour les feuille > nom 40
else
    Sh.PageSetup.PrintArea = "$A$58:$M$103"   ' aire pour les feuille jusqu'à nom 40
End If

Bonne suite

 

[mix770]

Re : macro pour imprimer une meme zone sur plusieurs onglets

Bonsoir paf,
merci de ta réponse désolé journée de dingue j'ouvre seulement mon pc.
je test tout de suite et te dit....
cordialement

 

[mix770]

Re : macro pour imprimer une meme zone sur plusieurs onglets

re, après essai, ci dessous le code j'ai le message "erreur d'application next sans for"

j'ai surement mal intégré tes codes, j’essaie de m'accoutumer au VBA, c'est pas toujours gagné

tu en pense quoi ?
merci

Private Sub Envoi_Février_Click()
Dim Sh As Worksheet
Application.ScreenUpdating = True
For Each Sh In Sheets
Num = Worksheets("nom 42").Index
If Sh.Name <> "Accueil Service continu" Then
If Sh.Index > Num Then
Sh.PageSetup.PrintArea = "$A$58:$L$106" ' aire pour les feuille > nom 43
Else
Sh.PageSetup.PrintArea = "$A$58:$M$103" ' aire pour les feuille jusqu'à nom 42
End If

Next Sh
Application.ActivePrinter = "PDFCreator sur Ne00:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"PDFCreator sur Ne00:", Collate:=True
Sheets("Accueil Service continu").Select
Unload Me
End Sub

Sub Archivage()

ChemindAcces = ThisWorkbook.Path & ":Fiche Client_"

With Worksheets("Impression")
NomClient = .Range("A2") & ".pdf"
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ChemindAcces & NomClient
End With

End Sub

erreur d'application "next sans for"

 

[mix770]

Re : macro pour imprimer une meme zone sur plusieurs onglets

re, après essai, ci dessous le code j'ai le message "erreur d'application next sans for"

j'ai surement mal intégré tes codes, j’essaie de m'accoutumer au VBA, c'est pas toujours gagné

tu en pense quoi ?
merci

Private Sub Envoi_Février_Click()
Dim Sh As Worksheet
Application.ScreenUpdating = True
For Each Sh In Sheets
Num = Worksheets("nom 42").Index
If Sh.Name <> "Accueil Service continu" Then
If Sh.Index > Num Then
Sh.PageSetup.PrintArea = "$A$58:$L$106" ' aire pour les feuille > nom 43
Else
Sh.PageSetup.PrintArea = "$A$58:$M$103" ' aire pour les feuille jusqu'à nom 42
End If

Next Sh
Application.ActivePrinter = "PDFCreator sur Ne00:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"PDFCreator sur Ne00:", Collate:=True
Sheets("Accueil Service continu").Select
Unload Me
End Sub

erreur de copier

 

[Paf]

Re : macro pour imprimer une meme zone sur plusieurs onglets

re,

je n'avais pas vérifier le code présenté, mais déjà dans le code du post #1 il devait y avoir messages d'erreurs puisqu'il manquait next sh et end if. Le message Next sans for ne signifie pas obligatoirement qu'il manque le next, parfois le défaut de end if provoque ce message (c'est ce qui se produit dans le cas présent)

Private Sub Envoi_Février_Click()
   Dim Sh As Worksheet
   Application.ScreenUpdating = True
   Num = Worksheets("nom 42").Index  ' ne pas inclure dans la boucle. Num est déterminé une seule fois

   For Each Sh In Sheets
      If Sh.Name <> "Accueil Service continu" Then
          If Sh.Index > Num Then
             Sh.PageSetup.PrintArea = "$A$58:$L$106" ' aire pour les feuille > nom 43 !! pas >43, mais >42
          Else
             Sh.PageSetup.PrintArea = "$A$58:$M$103" ' aire pour les feuille jusqu'à nom 42
          End If
      End If       'il manquait celui-là
  

  Application.ActivePrinter = "PDFCreator sur Ne00:"
  ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
  "PDFCreator sur Ne00:", Collate:=True

  Next Sh  ' si on met Next juste avant le code d'impression, seule la dernière feuille sera imprimée

  Sheets("Accueil Service continu").Select
  Unload Me
End Sub

bonne suite

Edit: on pourrait peut-être modifier le code ActiveWindow.SelectedSheets.PrintOut .... en Sh.PrintOut ..... .Mais, pas testé.