XL 2021 création d'étiquettes

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion AIGOIN
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Trier par date Trier par votes
job75 à dit:
C'est normal car la largeur 10,5 cm des Shapes est trop grande, Excel applique un zoom < 100 pour ajuster à une page en largeur.

Dans le fichier joint j'ai donné aux Shapes la taille 10,5 x 4 cm, l'impression les affiche à 10,1 x 3,5 cm chez moi.
Cliquez pour agrandir...
J'ai réussi à enfin trouver le bon paramétrage du shapes 41,5 x 105.
J'ai encore un petit problème quand j'ajoute des feuilles éleveurs je dois aller les ajouter à la main dans validation des données.
mettre une combobox ne serait-il pas possible?
Quoi qu'il en soit encore merci pour le travail, ça fonctionne super
 
Vote positif 0 Vote négatif
AIGOIN à dit:
je te renvois ma version modifié regarde à partir de la 5ème étiquette ça décale et il y a une grosse marge en bas de page j'en peux plus !!!!!
Cliquez pour agrandir...
Avec le classeur de #28, il n'y a aucun décalage parce que, d'une part tu as diminué la largeur de tes étiquettes (95 mm au lieu 105 mm, donc ça passe en largeur), et d'autre part tu as mal positionné tes étiquettes en hauteur (donc ça passe aussi en hauteur alors qu'avec 37 mm ça ne devrait pas passer).
 
Vote positif 0 Vote négatif
AIGOIN à dit:
J'ai réussi à enfin trouver le bon paramétrage du shapes 41,5 x 105.
Cliquez pour agrandir...
T'es sûr de ces dimensions ?

Si la dimension ne t'importe pas au millimètre près, tu configures l'imprimante pour imprimer automatiquement à la taille de la feuille et au moins tu es sûr que ça tiendra dans la feuille, quelles que soient les marges.
learn.microsoft.com

Propriété PageSetup.FitToPagesWide (Excel)

Rubrique de référence sur Office VBA
learn.microsoft.com
 
Dernière édition:
Vote positif 0 Vote négatif
AIGOIN à dit:
sur des dimensions
Cliquez pour agrandir...
Bizarre.

Mais, juste par curiosité, pourquoi être subitement passé à un format vertical d'étiquettes, plutôt que de continuer avec des étiquettes horizontales comme dans ton idée originelle mais en utilisant les dimensions maximales théoriques (éventuellement diminuées d'un millimètre pour assurer le coup) ?
 
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy à dit:
Bizarre.

Mais, juste par curiosité, pourquoi être subitement passé à un format vertical d'étiquettes, plutôt que de continuer avec des étiquettes horizontales comme dans ton idée originelle mais en utilisant les dimensions maximales théoriques (éventuellement diminuées d'un millimètre pour assurer le coup) ?
Cliquez pour agrandir...
Je ne comprends pas très bien ton raisonnement, la planche d'étiquettes est au format A4 et sur cette planche le format et le nombre d'étiquette peut varier donc je n'ai rien changé par rapport à la situation de départ 41,5 hauteur de l'étiquette 105 longueur de l'étiquette. à méditer
 
Vote positif 0 Vote négatif
AIGOIN à dit:
Je ne comprends pas très bien ton raisonnement
Cliquez pour agrandir...
Vu que tu disais être passé d'étiquettes de 105x37 mm à des étiquettes de 41,5x105 mm, je croyais que tu étais passé à un format vertical.

Et la suite de mon raisonnement reste la même qu'en #17 :
- largeur : 210-3-3 = 204 et 204/2 = 102
- hauteur : 297-3-3 = 291 et 291/8 = 36,375
Donc taille théorique d'une étiquette : 102x36 mm, mais par sécurité, éventuellement utiliser des étiquettes de 101x36 mm.

Mais, encore une fois, si tu n'as pas besoin d'avoir une précision au millimètre pour la taille de tes étiquettes, tu configures l'imprimante pour qu'elle ajuste les zooms de la partie à imprimer à la taille de la feuille. Au moins là tu seras sûr que ça tiendra dans la feuille. 😅
(je t'ai donné en #33 un lien avec la méhode à utiliser)
 
Dernière édition:
Vote positif 0 Vote négatif
Bonjour le forum,
AIGOIN à dit:
J'ai encore un petit problème quand j'ajoute des feuilles éleveurs je dois aller les ajouter à la main dans validation des données.
mettre une combobox ne serait-il pas possible?
Cliquez pour agrandir...
Il suffit de construire automatiquement la liste de validation avec cette macro dans la feuille "Créations" :
VB: 
Private Sub Worksheet_Activate()
Dim lig, w As Worksheet
lig = 2
With Columns("P")
    .Cells(lig) = "Toutes"
    For Each w In Worksheets
        If IsNumeric(w.Name) Then
            lig = lig + 1
            .Cells(lig) = w.Name
        End If
    Next
    .Cells(2).Resize(lig - 1).Name = "Liste" 'plage nommée
    .Cells(lig + 1).Resize(.Rows.Count - lig).ClearContents 'RAZ en dessous
End With
End Sub
Par ailleurs j'utilise maintenant cette macro, c'est plus propre :
VB: 
Sub Imprimer()
F.PageSetup.Zoom = False
F.PageSetup.FitToPagesWide = 1
F.PageSetup.FitToPagesTall = 1
'F.PrintOut 'pour imprimer
F.PrintPreview 'pour voir l'aperçu
F.DrawingObjects.Delete 'RAZ
n = 0: X = 0: Y = 0
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
job75 à dit:
Bonjour le forum,

Il suffit de construire automatiquement la liste de validation avec cette macro dans la feuille "Créations" :
VB: 
Private Sub Worksheet_Activate()
Dim lig, w As Worksheet
lig = 2
With Columns("P")
    .Cells(lig) = "Toutes"
    For Each w In Worksheets
        If IsNumeric(w.Name) Then
            lig = lig + 1
            .Cells(lig) = w.Name
        End If
    Next
    .Cells(2).Resize(lig - 1).Name = "Liste" 'plage nommée
    .Cells(lig + 1).Resize(.Rows.Count - lig).ClearContents 'RAZ en dessous
End With
End Sub
Par ailleurs j'utilise maintenant cette macro, c'est plus propre :
VB: 
Sub Imprimer()
F.PageSetup.Zoom = False
F.PageSetup.FitToPagesWide = 1
F.PageSetup.FitToPagesTall = 1
'F.PrintOut 'pour imprimer
F.PrintPreview 'pour voir l'aperçu
F.DrawingObjects.Delete 'RAZ
n = 0: X = 0: Y = 0
End Sub
A+
Cliquez pour agrandir...
Bonsoir,

Merci beaucoup, tout fonctionne super
Bonne soirée
 
Vote positif 0 Vote négatif
La feuille "Etiquettes" n'était pas nécessaire, on peut ajouter à chaque fois une feuille auxiliaire :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$J$3" Or Target(1) = "" Then Exit Sub
Dim w As Worksheet
n = 0: X = 0: Y = 0
Application.ScreenUpdating = False
Set F = Sheets.Add(, , 1) 'feuille auxiliaire
F.Columns.ColumnWidth = 0.1
With F.PageSetup
    .LeftMargin = 0
    .RightMargin = 0
    .TopMargin = 0
    .BottomMargin = 0
    .HeaderMargin = 0
    .FooterMargin = 0
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With
If Target = "Toutes" Then
    For Each w In Worksheets
        If IsNumeric(w.Name) Then Etiquettes w.Name
    Next w
Else
    Etiquettes CStr(Target)
End If
If F.DrawingObjects.Count Then Imprimer
Application.DisplayAlerts = False
F.Delete
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Pour finir encore une simplification du code :
VB: 
Sub Etiquettes(souche$)
Dim s1 As Shape, s2 As Shape, T As Range, i&, j&
Set s1 = Shapes("ZT_1"): Set s2 = Shapes("ZT_2")
Set T = Sheets(souche).ListObjects(1).Range
For i = 2 To T.Rows.Count Step 2
    If T(i, 7) = "couple" Then
        MAJ s1, T, i
    Else
        For j = i To i + 1
            MAJ s2, T, j
        Next j
    End If
Next i
End Sub

Sub MAJ(s As Shape, T As Range, i&)
Dim txt$, p%
n = n + 1
Do
    On Error Resume Next
    s.Copy
    F.Paste
Loop While Err
F.Shapes(n).Left = X
F.Shapes(n).Top = Y
If n Mod 2 Then
    X = F.Shapes(n).Width
Else
    X = 0
    Y = Y + F.Shapes(n).Height
End If
txt = F.Shapes(n).TextFrame.Characters.Text
txt = Replace(txt, "NOM PRENOM", T(-3, 3))
txt = Replace(txt, "1960", T(0, 3))
If T(i, 7) = "couple" Then
    txt = Replace(txt, "01 et 02", Format(T(i, 1), "00") & " et " & Format(T(i + 1, 1), "00"))
    txt = Replace(txt, "2025", T(i, 5))
    txt = Replace(txt, "2024", T(i + 1, 5))
    txt = Replace(txt, "011", Format(T(i, 4), "000"))
    txt = Replace(txt, "015", Format(T(i + 1, 4), "000"))
    txt = Replace(txt, "Perruche 1", T(i, 3))
    txt = Replace(txt, "Perruche 2", T(i + 1, 3))
    txt = Replace(txt, "40 E", T(i + 1, 7) & " E")
Else
    txt = Replace(txt, "32a", Format(T(i, 1), "00"))
    txt = Replace(txt, "2024", T(i, 5))
    txt = Replace(txt, "040", Format(T(i, 4), "000"))
    If T(i, 6) = "M" Then txt = Replace(txt, "FEMELLE", "MALE") Else txt = Replace(txt, "Femelle", "FEMELLE")
    txt = Replace(txt, "Perruche", T(i, 3))
    txt = Replace(txt, "25 E", T(i, 7) & " E")
End If
With F.Shapes(n).TextFrame
    .Characters.Text = txt
    p = InStr(txt, vbLf & "M ")
    If p Then .Characters(p + 1, 1).Font.Bold = True
    p = InStr(txt, "F ")
    If p Then .Characters(p, 1).Font.Bold = True
    p = InStr(txt, "VENTE")
    If p Then .Characters(p).Font.Bold = True
    p = InStr(txt, "Prix")
    If p Then .Characters(p).Font.Bold = True
End With
If n Mod 16 = 0 Then Imprimer
End Sub

Sub Imprimer()
If OptionButton1 Then F.PrintOut Else F.PrintPreview 'pour voir l'aperçu
F.DrawingObjects.Delete 'RAZ
n = 0: X = 0: Y = 0
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
job75 à dit:
Pour finir encore une simplification du code :
VB: 
Sub Etiquettes(souche$)
Dim s1 As Shape, s2 As Shape, T As Range, i&, j&
Set s1 = Shapes("ZT_1"): Set s2 = Shapes("ZT_2")
Set T = Sheets(souche).ListObjects(1).Range
For i = 2 To T.Rows.Count Step 2
    If T(i, 7) = "couple" Then
        MAJ s1, T, i
    Else
        For j = i To i + 1
            MAJ s2, T, j
        Next j
    End If
Next i
End Sub

Sub MAJ(s As Shape, T As Range, i&)
Dim txt$, p%
n = n + 1
Do
    On Error Resume Next
    s.Copy
    F.Paste
Loop While Err
F.Shapes(n).Left = X
F.Shapes(n).Top = Y
If n Mod 2 Then
    X = F.Shapes(n).Width
Else
    X = 0
    Y = Y + F.Shapes(n).Height
End If
txt = F.Shapes(n).TextFrame.Characters.Text
txt = Replace(txt, "NOM PRENOM", T(-3, 3))
txt = Replace(txt, "1960", T(0, 3))
If T(i, 7) = "couple" Then
    txt = Replace(txt, "01 et 02", Format(T(i, 1), "00") & " et " & Format(T(i + 1, 1), "00"))
    txt = Replace(txt, "2025", T(i, 5))
    txt = Replace(txt, "2024", T(i + 1, 5))
    txt = Replace(txt, "011", Format(T(i, 4), "000"))
    txt = Replace(txt, "015", Format(T(i + 1, 4), "000"))
    txt = Replace(txt, "Perruche 1", T(i, 3))
    txt = Replace(txt, "Perruche 2", T(i + 1, 3))
    txt = Replace(txt, "40 E", T(i + 1, 7) & " E")
Else
    txt = Replace(txt, "32a", Format(T(i, 1), "00"))
    txt = Replace(txt, "2024", T(i, 5))
    txt = Replace(txt, "040", Format(T(i, 4), "000"))
    If T(i, 6) = "M" Then txt = Replace(txt, "FEMELLE", "MALE") Else txt = Replace(txt, "Femelle", "FEMELLE")
    txt = Replace(txt, "Perruche", T(i, 3))
    txt = Replace(txt, "25 E", T(i, 7) & " E")
End If
With F.Shapes(n).TextFrame
    .Characters.Text = txt
    p = InStr(txt, vbLf & "M ")
    If p Then .Characters(p + 1, 1).Font.Bold = True
    p = InStr(txt, "F ")
    If p Then .Characters(p, 1).Font.Bold = True
    p = InStr(txt, "VENTE")
    If p Then .Characters(p).Font.Bold = True
    p = InStr(txt, "Prix")
    If p Then .Characters(p).Font.Bold = True
End With
If n Mod 16 = 0 Then Imprimer
End Sub

Sub Imprimer()
If OptionButton1 Then F.PrintOut Else F.PrintPreview 'pour voir l'aperçu
F.DrawingObjects.Delete 'RAZ
n = 0: X = 0: Y = 0
End Sub
Cliquez pour agrandir...
Bonjour,
C'est très bien, mais maintenant impossible de modifier et d'imprimer, je reste donc sur la version précédente qui fonctionne très bien.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Question Question
XL 2021 code postal dans combobox
Réponses
11
Affichages
155
AIGOIN
A
A
  • Résolu(e)
XL 2013 Création étiquette et nombre indiqué en colonne
Réponses
9
Affichages
759
acuponctus
A
V
  • Question Question
XL 2019 Fonction si
Réponses
7
Affichages
394
vipi61
V
W
  • Question Question
Microsoft 365 Aide sur petites formules et graphique..
Réponses
4
Affichages
132
WEIDER
W
C
  • Résolu(e)
XL 2016 rapatrier des données d'un onglet vers une feuille récapitulatrice via un menu déroulant
Réponses
4
Affichages
157
cocotte38
C
R
  • Question Question
XL 2021 Un planning/calendrier d'ouverture des points de ventes
Réponses
2
Affichages
344
Rocket
R
B
  • Question Question
Microsoft 365 Protection de zone de cellule selon utilisateur sur un fichier Excel
Réponses
2
Affichages
126
berta8683
B
M
  • Question Question
Microsoft 365 Masque de saisie Décaissement
Réponses
12
Affichages
413
Piment
P
S
  • Question Question
XL 2021 Lien mail hypertexte fonctionnel
Réponses
4
Affichages
220
sfconstant
S
D
  • Résolu(e)
XL 2016 Zone d'impression et mise en page
Réponses
4
Affichages
131
Phil69970
Phil69970
G
  • Question Question
Microsoft 365 insertion d'une ou plusieurs pièces jointe dans un mail via VBA
Réponses
6
Affichages
345
GG Delcroix
G
O
  • Question Question
XL 2016 Erreur d'exécution 32809 Erreur définie par l'application ou par l'objet
Réponses
0
Affichages
424
Oddoneju
O
S
  • Question Question
Autres destination Combobox1
Réponses
4
Affichages
388
stefezj
S
natorp
  • Résolu(e)
XL 2019 Rechercher en fonction d'une date
Réponses
7
Affichages
120
natorp
natorp
A
  • Question Question
XL 2021 Fichier Excel VBA mis en quarantaine par l'antivirus
2
Réponses
19
Affichages
851
fanch55
fanch55
Phoenix23
  • Résolu(e)
XL 2021 Tableau Classement Skull King
Réponses
6
Affichages
283
Cousinhub
Cousinhub
A
  • Résolu(e)
XL 2019 Optimisation code VBA (Icônes flottantes)
Réponses
14
Affichages
463
Amilo
A
K
  • Question Question
XL 2016 Création base donnée gestion assurance sociale des agents
Réponses
3
Affichages
314
krimodz2008
K
E
  • Question Question
XL 2013 classement du ligue de football
Réponses
4
Affichages
223
Noham
Noham
Y
  • Question Question
XL 2021 Bouton Macro
Réponses
6
Affichages
316
sylvanu
sylvanu
Retour