Impression et numérotation page aléatoire
Bonjour voici mon soucie j'ai un fichier avec des impressions de page dans 20 onglets certain des onglets on 2 feuilles à imprimé d'autre 1 seule les feuille ne s'imprime que si il son remplie, mon souci et de les numérotées de 1/1, 1/2, 1/3 etc...
J'ai essayé ce bout de code sur 4 feuilles à imprimées mais la numérotation commence à 47/1, 48/1, 56/1, et 49/1
Dim nbre As Byte, cptr As Byte
nbre = ThisWorkbook.Sheets.Count
For cptr = 1 To nbre
With Sheets(cptr).PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
NextMon code impression
Private Sub CommandButton5_Click()
' --- Impression Balzers
' +-------------- Désactive ou Réactive le mouvement du curseur ------------------------------------
Application.ScreenUpdating = False ' au début de ton code permet de demander à ton programme
' de ne pas afficher ces " mouvements " pendant le traitement.
' fonction à TRUE pour la réactiver False pour la désactive.
' +--------------------------------------------------------------------------------------------------
Sheets("OP-MA ML (1)<").Visible = True
Sheets("OP-MA ML (1)>").Visible = True
Sheets("FM-MLC (2)<").Visible = True
Sheets("FM-MLC (2)>").Visible = True
Sheets("FM-MLC (3)<").Visible = True
Sheets("FM-MLC (3)>").Visible = True
Sheets("FM-MLC (4)<").Visible = True
Sheets("FM-MLC (4)>").Visible = True
Sheets("FM-MLC (5)<").Visible = True
Sheets("FM-MLC (5)>").Visible = True
Sheets("FM-MA (6)<").Visible = True
Sheets("FM-MA (6)>").Visible = True
Sheets("FM-MA (7)<").Visible = True
Sheets("FM-MA (7)>").Visible = True
Sheets("FM-MLC (8)<").Visible = True
Sheets("FM-MLC (8)>").Visible = True
Sheets("Cran de Bille").Visible = True
Sheets("Foret MSM10").Visible = True
Sheets("Foret W1B81").Visible = True
Sheets("Foret W1B90").Visible = True
' +-------------- Désactive ou Réactive le mouvement du curseur ------------------------------------
Application.ScreenUpdating = True ' au début de ton code permet de demander à ton programme
' de ne pas afficher ces " mouvements " pendant le traitement.
' fonction à TRUE pour la réactiver False pour la désactive.
' +--------------------------------------------------------------------------------------------------
Dim nbre As Byte, cptr As Byte
nbre = ThisWorkbook.Sheets.Count
For cptr = 1 To nbre
With Sheets(cptr).PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
Next
If Sheets("OP-MA ML (1)<").Range("AA1").Value > 0 Then Sheets("OP-MA ML (1)<").PrintOut ' Impréssion des pages si AA1 suppérieur à 0
If Sheets("OP-MA ML (1)>").Range("AA1").Value > 0 Then Sheets("OP-MA ML (1)>").PrintOut
If Sheets("FM-MLC (2)<").Range("AA1").Value > 0 Then Sheets("FM-MLC (2)<").PrintOut
If Sheets("FM-MLC (3)<").Range("AA1").Value > 0 Then Sheets("FM-MLC (3)<").PrintOut
If Sheets("FM-MLC (4)<").Range("AA1").Value > 0 Then Sheets("FM-MLC (4)<").PrintOut
If Sheets("FM-MLC (5)<").Range("AA1").Value > 0 Then Sheets("FM-MLC (5)<").PrintOut
If Sheets("FM-MA (7)<").Range("AA1").Value > 0 Then Sheets("FM-MA (7)<").PrintOut
If Sheets("FM-MA (6)<").Range("AA1").Value > 0 Then Sheets("FM-MA (6)<").PrintOut
If Sheets("FM-MLC (8)<").Range("AA1").Value > 0 Then Sheets("FM-MLC (8)<").PrintOut
If Sheets("FM-MLC (2)>").Range("AA1").Value > 0 Then Sheets("FM-MLC (2)>").PrintOut
If Sheets("FM-MLC (3)>").Range("AA1").Value > 0 Then Sheets("FM-MLC (3)>").PrintOut
If Sheets("FM-MLC (4)>").Range("AA1").Value > 0 Then Sheets("FM-MLC (4)>").PrintOut
If Sheets("FM-MLC (5)>").Range("AA1").Value > 0 Then Sheets("FM-MLC (5)>").PrintOut
If Sheets("FM-MA (6)>").Range("AA1").Value > 0 Then Sheets("FM-MA (6)>").PrintOut
If Sheets("FM-MA (7)>").Range("AA1").Value > 0 Then Sheets("FM-MA (7)>").PrintOut
If Sheets("FM-MLC (8)>").Range("AA1").Value > 0 Then Sheets("FM-MLC (8)>").PrintOut
If Sheets("FM ESSAI").Range("X1").Value > 0 Then Sheets("FM ESSAI").PrintOut
If Sheets("Cran de Bille").Range("AA1").Value > 0 Then Sheets("Cran de Bille").PrintOut
If Sheets("Foret MSM10").Range("AA1").Value > 0 Then Sheets("Foret MSM10").PrintOut
If Sheets("Foret W1B81").Range("AA1").Value > 0 Then Sheets("Foret W1B81").PrintOut
If Sheets("Foret W1B90").Range("AA1").Value > 0 Then Sheets("Foret W1B90").PrintOut
' +-------------- Désactive ou Réactive le mouvement du curseur ------------------------------------
Application.ScreenUpdating = False ' au début de ton code permet de demander à ton programme
' de ne pas afficher ces " mouvements " pendant le traitement.
' fonction à TRUE pour la réactiver False pour la désactive.
' +--------------------------------------------------------------------------------------------------
Sheets("OP-MA ML (1)<").Visible = False
Sheets("OP-MA ML (1)>").Visible = False
Sheets("FM-MLC (2)<").Visible = False
Sheets("FM-MLC (2)>").Visible = False
Sheets("FM-MLC (3)<").Visible = False
Sheets("FM-MLC (3)>").Visible = False
Sheets("FM-MLC (4)<").Visible = False
Sheets("FM-MLC (4)>").Visible = False
Sheets("FM-MLC (5)<").Visible = False
Sheets("FM-MLC (5)>").Visible = False
Sheets("FM-MA (6)<").Visible = False
Sheets("FM-MA (6)>").Visible = False
Sheets("FM-MA (7)<").Visible = False
Sheets("FM-MA (7)>").Visible = False
Sheets("FM-MLC (8)<").Visible = False
Sheets("FM-MLC (8)>").Visible = False
Sheets("Cran de Bille").Visible = False
Sheets("Foret MSM10").Visible = False
Sheets("Foret W1B81").Visible = False
Sheets("Foret W1B90").Visible = False
' +-------------- Désactive ou Réactive le mouvement du curseur ------------------------------------
Application.ScreenUpdating = True ' au début de ton code permet de demander à ton programme
' de ne pas afficher ces " mouvements " pendant le traitement.
' fonction à TRUE pour la réactiver False pour la désactive.
' +--------------------------------------------------------------------------------------------------
Sheets("Référence").Select
Range("D1").Select
End SubBonsoir,
deux idées en une !
Voir le code ci-dessous :
' []extrait du code...
If Sheets("OP-MA ML (1)<").Range("AA1").Value > 0 Then
With Sheets("OP-MA ML (1)<").PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
Sheets("OP-MA ML (1)<").PrintOut ' Impréssion des pages si AA1 suppérieur à 0
End If
If Sheets("OP-MA ML (1)>").Range("AA1").Value > 0 Then
With Sheets("OP-MA ML (1)>").PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
Sheets("OP-MA ML (1)>").PrintOut
End If
' suite du code []
' ou alors si toutes ces feuilles se suivent
Dim i As Integer
For i = 1 To Worksheets.Count
If Sheets(i).Range("AA1").Value > 0 Then
With Sheets(i).PageSetup
.RightHeader = "&P" & "/" & i
End With
Sheets(i).PrintOut
End If
Next iPas essayé bien évidemment, pas de support...
@ bientôt
LouReeD
Bonsoir LouReeD désolé du retard, pour le code si dessous ne marche pas, j’ai page 0/1 sur chaque feuille merci pour ton aide
If Sheets("OP-MA ML (1)<").Range("AA1").Value > 0 Then
With Sheets("OP-MA ML (1)<").PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
Sheets("OP-MA ML (1)<").PrintOut ' Impréssion des pages si AA1 suppérieur à 0
End If
If Sheets("OP-MA ML (1)>").Range("AA1").Value > 0 Then
With Sheets("OP-MA ML (1)>").PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
Sheets("OP-MA ML (1)>").PrintOut
End If
If Sheets("FM-MA (Ion 7)<").Range("AA1").Value > 0 Then
With Sheets("FM-MA (Ion 7)<").PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
Sheets("FM-MA (Ion 7)<").PrintOut ' Impréssion des pages si AA1 suppérieur à 0
End If
If Sheets("FM-MA (Ion 7)<").Range("AA1").Value > 0 Then
With Sheets("FM-MA (Ion 7)<").PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
Sheets("FM-MA (Ion 7)<").PrintOut
End If
If Sheets("FM-MA (Ion 6)>").Range("AA1").Value > 0 Then
With Sheets("FM-MA (Ion 6)>").PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
Sheets("FM-MA (Ion 6)>").PrintOut ' Impréssion des pages si AA1 suppérieur à 0
End If
If Sheets("FM-MA (Ion 6)<").Range("AA1").Value > 0 Then
With Sheets("FM-MA (Ion 6)<").PageSetup
.RightHeader = "&P" & "/" & nbre
.FirstPageNumber = cptr
End With
Sheets("FM-MA (Ion 6)<").PrintOut
End IfBonsoir LouReeD voici mon fichier pour essai
Bonsoir,
je n'ai toujours pas essayé malgré la présence de votre fichier.
Je vous propose le code ci-dessous :
' on compte le nombre de page total des feuilles à imprimer donc AA1 > 0
Dim i As Integer, NB_P As Integer
NB_P = 0
For i = 1 To Worksheets.Count
If Sheets(i).Range("AA1").Value > 0 Then
NB_P = NB_P + (Sheets(i).HPageBreaks.Count + 1) * (Sheets(i).VPageBreaks.Count + 1)
End If
Next i
'NB_P est égal au nombre total de feuille à imprimer
' reste à gérer la numérotation des feuilles imprimées
Dim Num_P As Integer
Num_P = 1 ' c'est la valeur de la première page imprimée d'un onglet
For i = 1 To Worksheets.Count
If Sheets(i).Range("AA1").Value > 0 Then
With Sheets(i).PageSetup
.FirstPageNumber = Num_P
.RightHeader = "&P" & "/" & NB_P ' ici numérotation auto des feuilles en fonction du nombre de page
' que comporte l'onglet en commençant à Num_P
' donc la première page du premier onglet aura comme première numérotation Num_P = 1
' grâce à l'addition si dessous, lors de l'impression du deuxième onglet, la première page aura comme valeur
' 1 + le nombre de page imprimée sur l'onglet précédent.
End With
' on imprime
Sheets(i).PrintOut
' le compteur de numérotation de l'onglet suivant sera égal à Num_P + le nombre de page de l'onglet
Num_P = Num_P + (Sheets(i).HPageBreaks.Count + 1) * (Sheets(i).VPageBreaks.Count + 1)
End If
Next iPrincipe :
première boucle : on compte le nombre total de page à imprimer, comment ?
on boucle les feuilles dont la cellule AA1 est supérieure à 0, si c'est le cas on incrémente la variable NB_P (nombre de page) du total de page à imprimer sur cette feuilles c'est à dire le nombre de saut de page vertical x le nombre de saut de page horizontal.
et ainsi de suite, on arrive par exemple à 12
Deuxième boucle : on met en place la numérotation sur les feuilles à imprimer avec la valeur Num_P comme valeur de départ de numérotation automatique de l'onglet imprimé, puis on imprime, puis on incrémente Num_P afin de prendre en compte les pages déjà imprimées sur l'onglet précédent puis on renumérote la feuille suivante...
En espérant avoir été clair...
@ bientôt
LouReeD
Bonjour LouReeD et merci pour ton aide, fait l'essai avec ta macro mais s’arrête à " Sheets(i).PrintOut "
' on compte le nombre de page total des feuilles à imprimer donc AA1 > 0
Dim i As Integer, NB_P As Integer
NB_P = 0
For i = 1 To Worksheets.Count
If Sheets(i).Range("AA1").Value > 0 Then
NB_P = NB_P + (Sheets(i).HPageBreaks.Count + 1) * (Sheets
(i).VPageBreaks.Count + 1)
End If
Next i
'NB_P est égal au nombre total de feuille à imprimer
' reste à gérer la numérotation des feuilles imprimées
Dim Num_P As Integer
Num_P = 1 ' c'est la valeur de la première page imprimée d'un onglet
For i = 1 To Worksheets.Count
If Sheets(i).Range("AA1").Value > 0 Then
With Sheets(i).PageSetup
.FirstPageNumber = Num_P
.RightHeader = "&P" & "/" & NB_P ' ici numérotation auto des feuilles
en fonction du nombre de page
' que comporte l'onglet en commençant à Num_P
' donc la première page du premier onglet aura comme première
numérotation Num_P = 1
' grâce à l'addition si dessous, lors de l'impression du deuxième
onglet, la première page aura comme valeur
' 1 + le nombre de page imprimée sur l'onglet précédent.
End With
' on imprime
Sheets(i).PrintOut
' le compteur de numérotation de l'onglet suivant sera égal à Num_P + le
nombre de page de l'onglet
Num_P = Num_P + (Sheets(i).HPageBreaks.Count + 1) * (Sheets
(i).VPageBreaks.Count + 1)
End If
Next iBonjour,
elle s'arrête ? c'est à dire elle attend qu'on clique sur le bouton [imprimer] de l'aperçu avant impression, ou elle bug sur cette ligne là, ou encore rien des deux mais elle s'arrête...
@ bientôt
LouReeD
Bonjour,
je réfléchie mais je ne teste pas
@ vous la joie ou la déception en fonction du résultat
Dim i As Integer, NB_P As Integer
NB_P = 0
For i = 1 To Worksheets.Count
If Sheets(i).Range("AA1").Value > 0 Then
NB_P = NB_P + (Sheets(i).HPageBreaks.Count + 1) * (Sheets(i).VPageBreaks.Count + 1)
End If
Next i
' ensuite on sélectionne toutes les feuilles à imprimmer
Dim Feuille As Worksheet
For Each Feuille In ActiveWorkbook.Sheets
If Feuille.Range("AA1").Value > 0 Then
Sht.Select Replace:=False
End If
Next Feuille
' on gère la mise en page de l'impression
Selection.PageSetup.FirstPageNumber = 1
Selection.PageSetup.RightHeader = "&P" & "/" & NB_P
Selection.PrintOutLe principe, on sélectionne toutes les feuilles qui doivent être imprimées afin de ne gérer qu'une impression, du coup la numérotation est entièrement gérée par Excel, seul truc à calculer est le nombre de page total du document final...
@ bientôt
LouReeD
Bonjour LouReed voici l'erreur en image et si je fais débogage la macro et a l’arrêt sur " Sheets(i).PrintOut "
Bonsoir LouReed la 2 macro s’arrête à " Sht.Select Replace:=False "
Avez vous une imprimante de connectée à l'ordinateur ?
@ bientôt
LouReeD
Veuillez essayer en modifiant ce qui est surligné...
Dim i As Integer, NB_P As Integer
NB_P = 0
For i = 1 To Worksheets.Count
If Sheets(i).Range("AA1").Value > 0 Then
NB_P = NB_P + (Sheets(i).HPageBreaks.Count + 1) * (Sheets(i).VPageBreaks.Count + 1)
End If
Next i
' ensuite on sélectionne toutes les feuilles à imprimmer
Dim Feuille As Worksheet
For Each Feuille In ActiveWorkbook.Sheets
If Feuille.Range("AA1").Value > 0 Then
Sht.Select Replace:=False
End If
Next Feuille
' on gère la mise en page de l'impression
Selection.PageSetup.FirstPageNumber = 1
Selection.PageSetup.RightHeader = "&P" & "/" & NB_P
ActiveWindow.SelectedSheets.PrintOut@ bientôt
LouReeD
Bonjour LouReed oui mais pour faire les essai j’utilise " Microsoft XPS Document Writer " ?
Vous avez du manquer un post, non ?
Si Microsoft XPS Document Writer est considéré comme votre imprimante par défaut cela devrait marcher à moins du'Excel considère qu'il n'y a pas d'imprimante...
Regardez comme même le post ci-dessus juste avant le votre, j'ai modifié une ligne...
@ bientôt
LouReeD
Bonsoir LouReed oui mais pour faire les essais je mets une imprimante " Microsoft XPS "
Dans mon fichier j’ai 26 onglets non concerné par l’impression mais qui ont des cellules remplie en AA1 es qu’ils sont concernées à l’impression avec votre macro merci pour votre aide
Bonsoir,
si ces feuilles ne sont jamais concernées par l'impression alors pouvez vous ajouter un "_" Under score au début de leur nom par exemple et ainsi le code se transforme ainsi :
Dim i As Integer, NB_P As Integer
NB_P = 0
For i = 1 To Worksheets.Count
If Sheets(i).Range("AA1").Value > 0 And Left(Sheets(i),1)="_" Then
NB_P = NB_P + (Sheets(i).HPageBreaks.Count + 1) * (Sheets(i).VPageBreaks.Count + 1)
End If
Next i
' ensuite on sélectionne toutes les feuilles à imprimmer
Dim Feuille As Worksheet
For Each Feuille In ActiveWorkbook.Sheets
If Feuille.Range("AA1").Value > 0 And Left(Feuille.Name,1)="_" Then
Feuille.Select Replace:=False
End If
Next Feuille
' on gère la mise en page de l'impression
Selection.PageSetup.FirstPageNumber = 1
Selection.PageSetup.RightHeader = "&P" & "/" & NB_P
ActiveWindow.SelectedSheets.PrintOut@ bientôt
LouReeD
Bonjour LouReed j'ai tous essayer même avec un "_" Under score au début des feuilles mais problème avec les macros, je les caches au début de mon code plus simple pour moi, la macro s’arrête avec erreur d'exécution '424' Objet requis si je fais Débogage la macro et arrêté sur " Sht.Select Replace:=False " merci pour ta patience et ton aide.
Bonjour,
déjà il faut remplacer Sht par Feuille, regardez le dernier code fourni...
Ensuite si vos feuilles sont masquées alors le test serait plutôt celui-ci
If Sheets(i).Range("AA1").Value > 0 And Sheets(i).visible=True Then
et dans la deuxième boucle :
If Feuille.Range("AA1").Value > 0 And Feuille.visible=True Then
ce qui donne :
Dim i As Integer, NB_P As Integer
NB_P = 0
For i = 1 To Worksheets.Count
If Sheets(i).Range("AA1").Value > 0 And Sheets(i).Visible = True Then
NB_P = NB_P + (Sheets(i).HPageBreaks.Count + 1) * (Sheets(i).VPageBreaks.Count + 1)
End If
Next i
' ensuite on sélectionne toutes les feuilles à imprimmer
Dim Feuille As Worksheet
For Each Feuille In ActiveWorkbook.Sheets
If Feuille.Range("AA1").Value > 0 And Feuille.Visible = True Then
Feuille.Select Replace:=False
End If
Next Feuille
' on gère la mise en page de l'impression
Selection.PageSetup.FirstPageNumber = 1
Selection.PageSetup.RightHeader = "&P" & "/" & NB_P
ActiveWindow.SelectedSheets.PrintOut@ bientôt
LouReeD
Bonjour LouReed je me suis mal expliqué, je fais apparaitre les feuilles à imprimer avant impression mais j'ai d'autre onglet qui ne sont pas concernée par l’impression donc je les cache avant impression car il sont remplie en AA1 voici les feuilles concernées à l’impression si AA1 remplie
Sheets("OP-MA ML (Ion 1)<").Visible = True
Sheets("OP-MA ML (Ion 1)>").Visible = True
Sheets("FM-MLC (Ion 2)<").Visible = True
Sheets("FM-MLC (Ion 2)>").Visible = True
Sheets("FM-MLC (Ion 3)<").Visible = True
Sheets("FM-MLC (Ion 3)>").Visible = True
Sheets("FM-MLC (Ion 4)<").Visible = True
Sheets("FM-MLC (Ion 4)>").Visible = True
Sheets("FM-MLC (Ion 5)<").Visible = True
Sheets("FM-MLC (Ion 5)>").Visible = True
Sheets("FM-MA (Ion 6)<").Visible = True
Sheets("FM-MA (Ion 6)>").Visible = True
Sheets("FM-MA (Ion 7)<").Visible = True
Sheets("FM-MA (Ion 7)>").Visible = True
Sheets("FM-MLC (Ion 8)<").Visible = True
Sheets("FM-MLC (Ion 8)>").Visible = True
Sheets("Cran de Bille Ion").Visible = True
Sheets("Foret MSM10 Ion").Visible = True
Sheets("Foret W1B81 Ion").Visible = True
Sheets("Foret W1B90 Ion").Visible = True
et voici les feuilles non concerné par l’impression
Sheets("Calcul IonBond").Visible = False
Sheets("Récap envoie IonBond").Visible = False
Sheets("Total IonBond").Visible = False
Sheets("achat-catalogue jour IonBond").Visible = False
Sheets("Expéditions IonBond Jour").Visible = False
Sheets("Expédition IonBonD Semaine").Visible = False
Sheets("Couts par RG IonBond").Visible = False
Sheets("Expéditions IonBond mois").Visible = False
Merci
Bonjour,
vous pouvez toujour essayer quelque chose comme ceci:
Sheets("OP-MA ML (Ion 1)<").Visible = True
Sheets("OP-MA ML (Ion 1)<").Select Replace:=False
Sheets("OP-MA ML (Ion 1)>").Visible = True
Sheets("OP-MA ML (Ion 1)>").Select Replace:=False
Sheets("FM-MLC (Ion 2)<").Visible = True
Sheets("FM-MLC (Ion 2)<").Select Replace:=False
Sheets("FM-MLC (Ion 2)>").Visible = True
Sheets("FM-MLC (Ion 2)>").Select Replace:=False etc...
@ bientôt
LouReeD
Bonsoir LouReed, ce code fait quoi ?