Génération d'étiquette / Paramètre d'impression
Bonjour, à la demande de mon entreprise, j'élabore une macro Userform sur Excel.
L'objectif est de générer une étiquette à partir d'un tableau qui récupère des informations dans l'ERP de l'entreprise. La partie gestion des stocks / récupération des données est déjà terminée, mais concernant la création des étiquettes dynamiquement suite à l'extraction des données, c'est plus compliqué.
Créer l'étiquette dynamiquement, je sais le faire, mais c'est au moment de l'impression que ça se complique.
Nous avons des feuilles A4 de 21 cm de largeur pour 29,7 cm de hauteur. Sur une feuille A4, cette feuille possède quatre zones autocollante qui peuvent être retirées puis collées sur un carton. L'objectif est donc de dynamiquement, en fonction du nombre de pièces créées, générer des étiquettes en conséquence.
Nous appellerons cette feuille "Feuille active".
La macro remplissant le tableau ci-dessus est fonctionnelle, l'opérateur complète la partie avant "Coef" afin de signifier à la macro sur quelle étiquette l'information doit se reporter, l'information à afficher, la référence de l'article, la désignation de l'article et enfin la référence du plan. Le reste est rempli automatiquement par le script déjà en place.
Nous appellerons cette feuille "feuille Étiquette".
Ensuite, nous avons donc nos 3 étiquettes sur "Feuille Étiquette" qui récupère automatiquement le même nombre de lignes que "Feuille Active" dans la partie remplissable par l'utilisateur (Ligne 3 à 11), et en fonctions des valeurs de la colonne A, si A4("Feuille Active") = 1, on dispose les valeurs de la ligne sur l'étiquette 1/3. (1/3 et les positions de l'étiquette, si jamais la feuille active ne possède aucune valeur 3, mais que des 1 et des 2 le script détecte automatiquement et écrira dans l'étiquette 1/2).
Problématique :
Tout cela est déjà en place, j'en viens donc au moment de l'impression. J'ai besoin d'imprimer sur une feuille A4, sous forme de file d'attente, jusqu'à 4 étiquettes en fonction de mon besoin, au bon format, à la bonne position.
Sur une feuille A4, en horizontal, on peut donc mettre 4 étiquettes (en haut à gauche, à droite et en bas à gauche, à droite). Actuellement, je ne trouve pas de solutions, je gère très rarement des cas si sophistiqués d'impression et j'ai un peu de mal à me documenter sur ce type de cas de figure particulièrement.
Admettons qu'une pièce possède 3 étiquettes et qu'il me faut cette pièce 3 fois. Je devrais donc imprimer 3 * 3 étiquettes, les 9 étiquettes doivent être imprimer sur 9 divisé 4 étiquettes par feuille. 9/4 = 2,25 donc on doit l'imprimer sur 3 feuilles, en sachant que l'une des 3 feuilles aura 4 étiquettes vides.
Voilà une image du type de feuille, donc à l'horizontal nous devons imprimer les étiquettes. Je vous fournis mon code actuel :
Ici, le bouton Userform :
'====================================================================================
' GÉNÉRATION DES ÉTIQUETTES
'====================================================================================
Private Sub CommandButton1_Click()
' Étape 1 : Validation de la feuille active
Dim wsActive As Worksheet
Set wsActive = ActiveSheet
Dim feuilleBlacklist As Collection
Set feuilleBlacklist = New Collection
' Ajouter les noms des feuilles interdites
feuilleBlacklist.Add "Stock"
feuilleBlacklist.Add "Modèle"
feuilleBlacklist.Add "Etiquette"
Dim estBlacklistee As Boolean
Dim i As Long
estBlacklistee = False
' Vérification si la feuille est dans la liste noire
For i = 1 To feuilleBlacklist.Count
If wsActive.Name = feuilleBlacklist(i) Then
estBlacklistee = True
Exit For
End If
Next i
If estBlacklistee Then
MsgBox "Vous ne pouvez pas générer d'étiquettes sur cette feuille.", vbExclamation
Exit Sub
End If
' Étape 2 : Générer les étiquettes
Call GenererEtiquettes
' Étape 8 : Résumé avant impression
If Not ConfirmationImpression() Then Exit Sub
' Étape 9 : Impression
Call ImprimerEtiquettes
End SubIci la génération des étiquettes :
Sub GenererEtiquettes()
Dim wsActive As Worksheet, wsEtiquette As Worksheet
Dim lastRow As Long, ligneDebut As Long, lignesActives As Long
Dim i As Long, nbEtiquettes As Integer, ligneEtiquette As Long
Dim nomFeuille As String, valueBox4 As String, valueBox5 As String
Dim ofColumn As Integer, repValue As String
' Init des feuilles
Set wsActive = ActiveSheet
Set wsEtiquette = ThisWorkbook.Sheets("Etiquette")
nomFeuille = wsActive.Name
valueBox4 = TextBox4.Value ' Date
valueBox5 = TextBox5.Value ' Préparateur
lastRow = wsActive.Cells(wsActive.Rows.Count, 1).End(xlUp).Row
ligneDebut = 8 ' Ligne de départ pour les informations des étiquettes
nbEtiquettes = WorksheetFunction.Max(wsActive.Columns(1)) ' Nombre d'étiquettes nécessaires
' Clear des étiquettes
wsEtiquette.Rows(ligneDebut & ":" & wsEtiquette.Rows.Count).ClearContents
' On récupère nomFeuilleActive pour le mettre en titre d'étiquette
wsEtiquette.Range("C5:D5").Value = nomFeuille
wsEtiquette.Range("R5:S5").Value = nomFeuille
wsEtiquette.Range("AG5:AH5").Value = nomFeuille
' Récupération des datas de la feuille active
For i = 3 To lastRow
Dim etiquetteNumber As Integer
etiquetteNumber = wsActive.Cells(i, 1).Value
If etiquetteNumber = 0 Then Exit For ' Sortir si pas d'étiquette configurée
' Déterminer la colonne OF
If wsActive.Cells(i, 10).Value <> "" Then
ofColumn = 10
ElseIf wsActive.Cells(i, 13).Value <> "" Then
ofColumn = 13
ElseIf wsActive.Cells(i, 16).Value <> "" Then
ofColumn = 16
End If
' Récupération du "Rep"
repValue = Split(wsActive.Cells(i, 2).Value, "-")(0)
' Insertion des données
Select Case etiquetteNumber
Case 1
ligneEtiquette = ligneDebut
Do While wsEtiquette.Cells(ligneEtiquette, 1).Value <> ""
ligneEtiquette = ligneEtiquette + 1
Loop
RemplirEtiquette wsActive, wsEtiquette, i, ligneEtiquette, 1, ofColumn, repValue
Case 2
ligneEtiquette = ligneDebut
Do While wsEtiquette.Cells(ligneEtiquette, 16).Value <> ""
ligneEtiquette = ligneEtiquette + 1
Loop
RemplirEtiquette wsActive, wsEtiquette, i, ligneEtiquette, 2, ofColumn, repValue
Case 3
ligneEtiquette = ligneDebut
Do While wsEtiquette.Cells(ligneEtiquette, 31).Value <> ""
ligneEtiquette = ligneEtiquette + 1
Loop
RemplirEtiquette wsActive, wsEtiquette, i, ligneEtiquette, 3, ofColumn, repValue
End Select
Next i
' Récupération de l'opérateur et de la date
wsEtiquette.Range("D" & ligneDebut - 1).Value = valueBox5 ' Préparateur
wsEtiquette.Range("F" & ligneDebut - 1).Value = valueBox4 ' Date
wsEtiquette.Range("F" & ligneDebut - 1).Font.Size = 10 ' Réduction de la taille de la date
MsgBox "Les étiquettes ont été générées avec succès.", vbInformation
End Subla fonction pour remplir les etiquettes :
Sub RemplirEtiquette(wsActive As Worksheet, wsEtiquette As Worksheet, i As Long, ligneEtiquette As Long, etiquetteNumber As Integer, ofColumn As Integer, repValue As String)
Dim colOffset As Integer
Select Case etiquetteNumber
Case 1: colOffset = 0
Case 2: colOffset = 15
Case 3: colOffset = 30
End Select
wsEtiquette.Cells(ligneEtiquette, 1 + colOffset).Value = repValue ' Rep
wsEtiquette.Cells(ligneEtiquette, 2 + colOffset).Value = wsActive.Cells(i, 7).Value ' Quantité
wsEtiquette.Cells(ligneEtiquette, 3 + colOffset).Value = wsActive.Cells(i, ofColumn).Value ' OF
wsEtiquette.Cells(ligneEtiquette, 4 + colOffset).Value = wsActive.Cells(i, 2).Value ' Article
wsEtiquette.Cells(ligneEtiquette, 5 + colOffset).Value = wsActive.Cells(i, 6).Value ' Réf. Plan
wsEtiquette.Cells(ligneEtiquette, 6 + colOffset).Value = wsActive.Cells(i, 4).Value ' Désignation
End SubLa confirmation d'impression :
Function ConfirmationImpression() As Boolean
' Résumé des impressions à effectuer
Dim wsEtiquette As Worksheet
Set wsEtiquette = ThisWorkbook.Sheets("Etiquette")
Dim nbCartons As Integer
Dim message As String
Dim carton1 As Double, carton2 As Double, carton3 As Double
' Calculer le nombre de cartons
carton1 = Val(wsEtiquette.Range("F4").Value)
carton2 = Val(wsEtiquette.Range("U4").Value)
carton3 = Val(wsEtiquette.Range("AJ4").Value)
nbCartons = Application.WorksheetFunction.Max(carton1, carton2, carton3)
message = "Voici les étiquettes prêtes à être imprimées :" & vbCrLf & vbCrLf
If carton1 > 0 Then message = message & "Étiquette 1 : " & wsEtiquette.Cells(4, 6).Value & vbCrLf
If carton2 > 0 Then message = message & "Étiquette 2 : " & wsEtiquette.Cells(4, 21).Value & vbCrLf
If carton3 > 0 Then message = message & "Étiquette 3 : " & wsEtiquette.Cells(4, 36).Value & vbCrLf
message = message & vbCrLf & "Voulez-vous imprimer ces étiquettes ?"
If MsgBox(message, vbQuestion + vbYesNo, "Confirmation d'impression") = vbYes Then
ConfirmationImpression = True
Else
ConfirmationImpression = False
End If
End FunctionL'impression des étiquettes :
Sub ImprimerEtiquettes()
Dim wsEtiquettes As Worksheet
Dim tempSheet As Worksheet
Dim nbEtiquettes As Integer
Dim i As Integer, quadrant As Integer
Dim rowOffset As Integer, colOffset As Integer
Dim zoneToCopy As Range
Dim targetCell As Range
'Création d'une feuille/init de la feuille etiquette
Set wsEtiquettes = ThisWorkbook.Sheets("Etiquette")
Set tempSheet = ThisWorkbook.Sheets("Etiquettes_Page")
tempSheet.Cells.Clear
' Config de la page
With tempSheet.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PaperSize = xlPaperA4
.TopMargin = 0
.BottomMargin = 0
.LeftMargin = 0
.RightMargin = 0
End With
' Pour le moment seulement une par une pour les tests
nbEtiquettes = WorksheetFunction.CountA(wsEtiquettes.Range("A:A"))
' Tentative de création de quadrant pour gérer les impressions
Dim quadrantHeight As Double, quadrantWidth As Double
quadrantHeight = 20 ' Lignes par quadrant
quadrantWidth = 10 ' Colonnes par quadrant
' Itérer sur chaque étiquette et la positionner dans le quadrant approprié
For i = 1 To nbEtiquettes
quadrant = (i - 1) Mod 4 + 1 ' Déterminer le quadrant courant
Select Case quadrant
Case 1 ' Haut gauche
rowOffset = 1
colOffset = 1
Case 2 ' Haut droite
rowOffset = 1
colOffset = 11
Case 3 ' Bas gauche
rowOffset = 21
colOffset = 1
Case 4 ' Bas droite
rowOffset = 21
colOffset = 11
End Select
' Copier l'étiquette dans le quadrant
Set zoneToCopy = wsEtiquettes.Range("A" & i & ":F" & i)
Set targetCell = tempSheet.Cells(rowOffset, colOffset)
zoneToCopy.Copy
targetCell.PasteSpecial Paste:=xlPasteAll
' Imprimer la page si 4 quadrants remplis ou toute les étiquettes gérer
If quadrant = 4 Or i = nbEtiquettes Then
tempSheet.PrintOut copies:=1, Collate:=True
tempSheet.Cells.Clear
End If
Next i
' Supprimer les sélections
Application.CutCopyMode = False
MsgBox "Impression terminée avec succès.", vbInformation
End SubJ'espère avoir été clair dans ma démonstration, sinon je reste très disponible, si quelqu'un a une solution pour la génération dynamique d'étiquettes. Peut-être que ma méthode n'est juste pas la bonne, aucune idée à vrai dire, mais actuellement, je tourne en rond vis-à-vis de ce problème, je m'en remets donc à vous.
Bonne journée et merci de m'avoir lu
Voici un petit Diagram pour mieux expliquer le fonctionnement et la dynamique des impressions
avez-vous un fichier avec cette feuille "Etiquette" ?
Bonjour, ci-joint le fichier avec le code réadapté pour pouvoir le publié en ligne.
Userform2 -> Impression étiquettes
La partie génération des étiquettes ce trouve tout en bas du fichier dans l'ide.
'====================================================================================
' GÉNÉRATION DES ÉTIQUETTES
'====================================================================================
re,
voir ma macro "Imprimer". On crée une matrice avec 4 éléments par feuille, chaque élément est l'étiquette voulu. L'astuce est de copier chaque étiquette dans une graphique.
re, merci pour la piste :
j'ai tenté d'adapté ta méthode à mon besoin mais je n'arrive pas à imprimer les 4 zones comme suit :
Feuille "Graph" :
Zone :
Chart 1
Chart 2
Chart 3
Chart 4
Les 4 charts une fois assemblé forme la feuille A4 à l'horizontal (En gros on a 4 étiquettes par feuilles A4)
nbEtiquette = TextBox1.Value
Si on possède 1/1 étiquettes
On prends en photo l'étiquette 1 * nbEtiquette
On la positionne sur Chart1, Chart2 ... (Le nombre d'étiquette dont on as besoin)
Si on en demande 5 étiquettes ou plus, on imprime une avec 4 et une avec 1 et etc
puis on passe à l'étiquette 2 *nbEtiquette si nécéssaire (si elle existes)
puis on passe à l'étiquette 3 *nbEtiquette si nécéssaire (si elle existes)
L'objectif est d'ombre d'imprimé Etiquette1, Etiquette2, Etiquette3 * nbEtiquette et donc comme une file d'attente on fait ainsi :
------------Mise en situation
si qtt = 2
si nous avons généré 3 étiquettes
Impression 1
Chart 1 = Etiquette1
Chart 2 = Etiquette2
Chart 3 = Etiquette3
Chart 4 = Etiquette1
Impression 2
Chart 1 = Etiquette2
Chart 1 = Etiquette3
si qtt = 2
si nous avons 2 étiquettes
Impression 1
Chart 1 = Etiquette1
Chart 2 = Etiquette2
Chart 3 = Etiquette1
Chart 4 = Etiquette2
si qtt = 8
si nous avons 1 étiquettes
Impression 1
Chart 1 = Etiquette1
Chart 2 = Etiquette1
Chart 3 = Etiquette1
Chart 4 = Etiquette1
Impression 2
Chart 1 = Etiquette1
Chart 2 = Etiquette1
Chart 3 = Etiquette1
Chart 4 = Etiquette1
ma problématique reste toujours de positionner les 4 étiquettes sur ma feuille, une fois que j'arriverai à le faire je pourrais généré dynamiquement une file d'attente qui réponds à mon besoin.
J'ai surement mal interprété l'une des vos réponses.
'====================================================================================
' GÉNÉRATION DES ÉTIQUETTES
'====================================================================================
Private Sub CommandButton1_Click()
Call GenererEtiquettes
Call ImprimerEtiquettes
End Sub
Sub GenererEtiquettes()
Dim wsActive As Worksheet, wsEtiquette As Worksheet
Dim lastRow As Long, ii1 As Long, ii2 As Long, ii3 As Long
Dim i As Long, numEtiquette As Integer
Dim positionPiece As String, infoAfficher As String
Dim designation As String, refPlan As String, coef As String, ofPrepa As String
Dim prepaChoisie As String
Dim count1 As Long, count2 As Long, count3 As Long
' Initialisation
Set wsActive = ActiveSheet
Set wsEtiquette = ThisWorkbook.Sheets("Etiquette")
lastRow = wsActive.Cells(wsActive.Rows.Count, 1).End(xlUp).Row
ii1 = 8: ii2 = 8: ii3 = 8 ' Points de départ pour les étiquettes
count1 = 0: count2 = 0: count3 = 0 ' Compteurs pour chaque type d'étiquette
prepaChoisie = InputBox("Indiquez la prépa (1, 2 ou 3) :", "Choix Prépa", "1")
If prepaChoisie <> "1" And prepaChoisie <> "2" And prepaChoisie <> "3" Then
MsgBox "Prépa invalide.", vbExclamation
Exit Sub
End If
' Nettoyer les anciennes données
With wsEtiquette
.Range("F4").ClearContents
.Range("U4").ClearContents
.Range("AJ4").ClearContents
.Rows("8:15").ClearContents
End With
' Parcourir les lignes de la feuille active
For i = 3 To lastRow
numEtiquette = wsActive.Cells(i, 1).Value ' Numéro d'étiquette
infoAfficher = wsActive.Cells(i, 2).Value ' Info dans la colonne B
positionPiece = ExtrairePremierChiffre(wsActive.Cells(i, 2).Value) ' Position de la pièce
designation = wsActive.Cells(i, 4).Value ' Désignation
refPlan = wsActive.Cells(i, 6).Value ' Réf. Plan
coef = wsActive.Cells(i, 7).Value ' Coef
' Récupérer l'OF en fonction de la prépa choisie
Select Case prepaChoisie
Case "1": ofPrepa = wsActive.Cells(i, 10).Value ' OF Prépa1 (Colonne J)
Case "2": ofPrepa = wsActive.Cells(i, 13).Value ' OF Prépa2 (Colonne M)
Case "3": ofPrepa = wsActive.Cells(i, 16).Value ' OF Prépa3 (Colonne P)
End Select
' Remplir les étiquettes en fonction du numéro d'étiquette
Select Case numEtiquette
Case 1
wsEtiquette.Cells(ii1, 1).Value = positionPiece ' Colonne A
wsEtiquette.Cells(ii1, 2).Value = coef ' Colonne B
wsEtiquette.Cells(ii1, 3).Value = ofPrepa ' Colonne C
wsEtiquette.Cells(ii1, 4).Value = infoAfficher ' Colonne D
wsEtiquette.Cells(ii1, 5).Value = refPlan ' Colonne E
wsEtiquette.Cells(ii1, 6).Value = designation ' Colonne F
ii1 = ii1 + 1
count1 = 1
Case 2
wsEtiquette.Cells(ii2, 16).Value = positionPiece ' Colonne P
wsEtiquette.Cells(ii2, 17).Value = coef ' Colonne Q
wsEtiquette.Cells(ii2, 18).Value = ofPrepa ' Colonne R
wsEtiquette.Cells(ii2, 19).Value = infoAfficher ' Colonne S
wsEtiquette.Cells(ii2, 20).Value = refPlan ' Colonne T
wsEtiquette.Cells(ii2, 21).Value = designation ' Colonne U
ii2 = ii2 + 1
count1 = 2
count2 = 2
Case 3
wsEtiquette.Cells(ii3, 31).Value = positionPiece ' Colonne AE
wsEtiquette.Cells(ii3, 32).Value = coef ' Colonne AF
wsEtiquette.Cells(ii3, 33).Value = ofPrepa ' Colonne AG
wsEtiquette.Cells(ii3, 34).Value = infoAfficher ' Colonne AH
wsEtiquette.Cells(ii3, 35).Value = refPlan ' Colonne AI
wsEtiquette.Cells(ii3, 36).Value = designation ' Colonne AJ
ii3 = ii3 + 1
count1 = 3
count2 = 3
count3 = 3
End Select
Next i
' Ajouter les informations de l'opérateur et de la date
wsEtiquette.Cells(16, 4).Value = TextBox5.Value ' Opérateur pour Étiquette 1
wsEtiquette.Cells(16, 6).Value = TextBox4.Value ' Date pour Étiquette 1
wsEtiquette.Cells(16, 19).Value = TextBox5.Value ' Opérateur pour Étiquette 2
wsEtiquette.Cells(16, 21).Value = TextBox4.Value ' Date pour Étiquette 2
wsEtiquette.Cells(16, 34).Value = TextBox5.Value ' Opérateur pour Étiquette 3
wsEtiquette.Cells(16, 36).Value = TextBox4.Value ' Date pour Étiquette 3
' Calculer les valeurs pour F4, U4, et AJ4
wsEtiquette.Range("F4").Value = "1 / " & count1
wsEtiquette.Range("U4").Value = "2 / " & count2
wsEtiquette.Range("AJ4").Value = "3 / " & count3
MsgBox "Étiquettes générées avec succès.", vbInformation
End Sub
Function ExtrairePremierChiffre(valeur As String) As String
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "\((\d)-" ' Capturer le premier chiffre dans les parenthèses
regex.IgnoreCase = True
regex.Global = False
If regex.Test(valeur) Then
ExtrairePremierChiffre = regex.Execute(valeur)(0).SubMatches(0)
Else
ExtrairePremierChiffre = ""
End If
End Function
Sub ImprimerEtiquettes()
Dim wsGraph As Worksheet
Dim etiqList As Variant
Dim maxCharts As Integer
Dim nbEtiquettes As Integer
Dim totalEtiquettes As Integer
Dim currentPage As Integer
Dim etiqIndex As Integer
Dim chartIndex As Integer
' Initialisation
Set wsGraph = ThisWorkbook.Sheets("Graph")
etiqList = Array("Etiq_1", "Etiq_2", "Etiq_3") ' Noms des étiquettes disponibles
maxCharts = 4 ' Nombre de zones Chart (max 4 étiquettes par page)
nbEtiquettes = CInt(InputBox("Entrez le nombre d'étiquettes par kit :", "Nombre d'étiquettes", "1"))
If nbEtiquettes <= 0 Then
MsgBox "Nombre d'étiquettes invalide.", vbExclamation
Exit Sub
End If
totalEtiquettes = nbEtiquettes * (UBound(etiqList) + 1) ' Total des étiquettes à imprimer
currentPage = 1
etiqIndex = 0 ' Index pour parcourir la liste des étiquettes
Do While totalEtiquettes > 0
' Nettoyer les graphiques pour la page actuelle
For chartIndex = 1 To maxCharts
With wsGraph.ChartObjects("Chart " & chartIndex).Chart
Do While .Shapes.Count > 0
.Shapes(1).Delete
Loop
End With
Next chartIndex
' Ajouter les étiquettes aux graphiques
For chartIndex = 1 To maxCharts
If totalEtiquettes = 0 Then Exit For
Call CopierEtiquette(wsGraph, CStr(etiqList(etiqIndex)), chartIndex)
' Passer à l'étiquette suivante
etiqIndex = etiqIndex + 1
If etiqIndex > UBound(etiqList) Then etiqIndex = 0 ' Revenir au début de la liste si nécessaire
totalEtiquettes = totalEtiquettes - 1
Next chartIndex
' Prévisualisation ou impression de la page
'wsGraph.PrintPreview ' Remplacez par .PrintOut pour imprimer directement
wsGraph.PrintOut
' Passer à la page suivante
currentPage = currentPage + 1
Loop
MsgBox "Impression des étiquettes terminée.", vbInformation
End Sub
Sub CopierEtiquette(wsGraph As Worksheet, etiqName As String, chartIndex As Integer)
Dim wsEtiquette As Worksheet
Dim rngEtiquette As Range
' Initialisation
Set wsEtiquette = ThisWorkbook.Sheets("Etiquette")
' Vérification de la plage de l'étiquette
On Error Resume Next
Set rngEtiquette = wsEtiquette.Range(etiqName)
On Error GoTo 0
If rngEtiquette Is Nothing Then
MsgBox "L'étiquette " & etiqName & " n'existe pas.", vbExclamation
Exit Sub
End If
' Copier l'étiquette en image
rngEtiquette.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' Coller l'image dans le graphique correspondant
With wsGraph.ChartObjects("Chart " & chartIndex).Chart
.Paste
With .Shapes(1)
.LockAspectRatio = msoTrue
.Width = .Parent.PlotArea.InsideWidth
.Height = .Parent.PlotArea.InsideHeight
.Left = (.Parent.PlotArea.InsideWidth - .Width) / 2
.Top = (.Parent.PlotArea.InsideHeight - .Height) / 2
End With
End With
End Subje ne sais pas ce qu'il est plus important, la vitesse d'imprimer ou la séquence. Je suppose la vitesse.
Dans la macro, la ligne avec "copypicture" est la plus dangeureuse pour causer des erreurs, donc on doit freiner un peu l'exécution de la macro et minimaliser le nombre de fois qu'on change d'etiquette dans une graphique. (Dans ma macro, je trie les etiquettes dans une séquence ascendante, par exemple)
Il faut simplement donner un string à la macro "Sequence_Impression", voir les macros "Exemple" et "Exemple2"
Je ne voyais pas cette séquence dans vos macros et je ne voyais pas ce delai, donc peut-être vous pouvez jouer avec la valeur de "t2" dans la macro "Delai".
Salut BsAlv, désolé pour la réponse tardive :(
Je reviens après avoir fait pas mal de test et effectivement, votre macro fonctionne bien mais dans mon cas que lors de la première impression.
J'ai rendu le tout compatible avec mon userform, j'envoie juste en paramètre ce dont j'ai besoin à ta logique exemple :
Si Kit 1 à besoin de 3 étiquettes, et qu'il nous faut 3 kits on envoie :
111222333
Lors de la première impression on a bien une feuille A4 divisé par 4 qui s'imprime niquel avec 1112
puis la deuxième impression on à juste une feuille pleine avec une étiquettes qui prends tout l'écran (3)
Et la troisième également
Merci beaucoup pour l'aide déjà apporter il est clair que vous êtes d'une grande aide !
J'avais envoyé la mauvaise version.
J'ai essayé de faire en sorte de vidé les chart des que les 4 sont pleines pour recommencer en haut à gauche, normalement une fois une étiquette utilisé on doit pas la laisser pour la prochaine impression.
V = VIDE
1231 Impression 1
2312 Impression 2
3123 Impression 3
1231 Impression 4
23VV Impression 5
re,
le problème est qu'on ne peut pas sélectionner une graphique, oubien les 4 ensemble oubien aucune (en sélectionnant une cellule dehors)
Mais je ne comprends pas pourquoi, mais avec cette cellule, le problème persiste, donc maintenant dans la macro vous voyez 3 lignes avec des asteriks
With Sheets("graph")
If ActiveSheet.Name <> .Name Then .Activate '******************************************************
.Shapes.SelectAll 'selectionnez tous les shapes (4)'******************************************
If bPageSetup Then ....et puis quand on a fini
.Range("BC1").Select 'déselect shapes en sélectionnant une cellule '****************************************Et je crois que la macro "Call NettoyerImagesGraphiques" sert à rien parce que les graphiques sont vides quand nécessaire.
C'est mieux ? (sinon, peut-être je dois créer un "groupe" de ces 4 graphiques et imprimer le groupe)
Salut BsAlv, je reviens quelque jours après vers vous pour vous remerciez ! J'ai enfin réussi grace à votre code en grande partie à atteindre mon objectifs ! Le rendu est plutôt propre et semble bien fonctionnel sans trop de bug (j'ai rajouté pas mal de delai quand même).
Merci beaucoup !