Microsoft 365 Sélection d'étiquettes sur une planche

[jcf6464]

Bonjour le forum,

j'ai une question
je viens de récupérer un classeur (Voir classeur ci-dessous) pour créer des étiquettes il fonctionne,
je voudrais rajouter une fonction cet à dire j'emploie 3 étiquettes de la planche première impression
dans ma deuxième impression de 2 étiquettes je souhaiterai que impression commence à l'étiquette (4)
et ainsi de suite suivant les demande d'impression cela économiserai des planches

Bonne journée jcf6464

 

[sylvanu]

Bonjour JCF,
N'est pas déjà le cas avec votre fichier ?
En feuille 1 vous sélectionnez avec le filtre les personnes concernées, et en feuille Etiquette vous avez uniquement les étiquettes des personnes concernées.

 

[dysorthographie]

bonjour,
le problème n'est pas temps les étiquettes dans le classeur mais la planche physique papier dans l'imprimante.

il faudrait pouvoir donner l'étiquette de start pour ajouter des emplacement vide au début de page.

disons j'avais imprimé précédent 5 étiquettes sur un planche qui en contient 6 ii me reste une étiquette. donc à la prochaine impression je dois insérer au début 5 étiquettes vide pour consommer la dernière étiquette de la planche.

il faut gêner un onglet d'étiquette avec un multiple de 6 étiquettes par pages et don le starte doit être défini avant.

 

[jcf6464]

Bonjour JCF,
N'est pas déjà le cas avec votre fichier ?
En feuille 1 vous sélectionnez avec le filtre les personnes concernées, et en feuille Etiquette vous avez uniquement les étiquettes des personnes concernées.
Regarde la pièce jointe 1224793

Regarde la pièce jointe 1224794

Bonjour à vous tous
oui on sélectionne par le trie cela va
mais comme dis dysorthographie (il faudrait pouvoir donner l'étiquette de start pour ajouter des emplacements vide au début de page.)

Cordialement jcf

 

[dysorthographie]

imaginons que nous avons 6 étiquettes par planche.

je compte les étiquettes que j'imprime.
disons 1 sur un planche entière.
1 module 6 =1 sur la prochaine j'ai 5 étiquettes
j'en imrime 6
6 Modulo 6 =0 j'en ai 6 étiquettes sur la prochaine planche
j'en imprime 25
25 Modulo 6=1 je ai 5 étiquettes sur la prochaine planche
a moi de tenir compte du décalage pour la génération des prochaines impression.

donc on commence par renseigner dans une cellule excel disponible 0 Si la prochaine impression commence sur une planche entière, 1,2,3 etc si l'impression commence en 2,3,4, on insère 1,2 ou trois emplacement vide en début de page, disons en fonction du Modulo sauvegardé.

puis on ajoute les étiquettes. on sauvegarde le Modulo en fonction du nombre d'étiquette par pages sans oublier de compter les emplacements vide ce Modulo sera considéré comme étiquettes de Start.

j'ai pas pris en compte le nombre de colonnes mais là le Modulo fonctionne également.

 

[jcf6464]

imaginons que nous avons 6 étiquettes par planche.

je compte les étiquettes que j'imprime.
disons 1 sur un planche entière.
1 module 6 =1 sur la prochaine j'ai 5 étiquettes
j'en imrime 6
6 Modulo 6 =0 j'en ai 6 étiquettes sur la prochaine planche
j'en imprime 25
25 Modulo 6=1 je ai 5 étiquettes sur la prochaine planche
a moi de tenir compte du décalage pour la génération des prochaines impression.

donc on commence par renseigner dans une cellule excel disponible 0 Si la prochaine impression commence sur une planche entière, 1,2,3 etc si l'impression commence en 2,3,4, on insère 1,2 ou trois emplacement vide en début de page, disons en fonction du Modulo sauvegardé.

puis on ajoute les étiquettes. on sauvegarde le Modulo en fonction du nombre d'étiquette par pages sans oublier de compter les emplacements vide ce Modulo sera considéré comme étiquettes de Start.

j'ai pas pris en compte le nombre de colonnes mais là le Modulo fonctionne également.

bonsoir à vous tous et le forum,
pour infos
Les planches que j'ai en ma possession sont de 14 étiquettes sur 2 colonnes

bonne soirée jcf

 

[dysorthographie]

Bonjour,

Option Explicit

Private Sub CommandButton1_Click()
PrintPreview
If MsgBox("L'immpression c'es biepassé", vbQuestion + vbYesNo) = vbYes Then [Modulo] = [ModuloTemp]: [ModuloTemp] = 0
End Sub

Private Sub CommandButton2_Click()
PrintOut
[Modulo] = [ModuloTemp]: [ModuloTemp] = 0
End Sub

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim ValNom1$, ValNom2$, ValNom$, ValCivil1$, ValCivil2$
Dim Derlig&, i&, Lig&, Col$, Cptr&, Nb%
Dim Start As Integer, Nbetiquette As Integer
Start = [Modulo]
Set Ws1 = Worksheets("Feuil1")
Set Ws2 = Worksheets("Etiquette")

Ws2.Range("A:B").ClearContents
Derlig = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Col = "A": Lig = 1: Nb = 1
With Ws1
For Nbetiquette = 1 To Start
    If Nbetiquette Mod 2 = 0 Then Lig = Lig + 8
                If Col = "A" Then
                    Col = "B": ' Lig = Lig - 8
                Else
                    Col = "A": Lig = Lig
                End If
               
                Cptr = Cptr + 1
                If Cptr = 16 * Nb Then Lig = Lig + 2: Nb = Nb + 1
Next
Nbetiquette = Nbetiquette - 1
    For i = 2 To Derlig
        If .Rows(i).Hidden = False Then
            ValNom1 = .Range("C" & i) & " " & .Range("E" & i) & " " & .Range("G" & i) & " " & .Range("H" & i)
            If .Rows(i + 1).Hidden = True Then
                ValNom2 = ""
            Else
                ValNom2 = .Range("C" & i + 1) & " " & .Range("E" & i + 1) & " " & .Range("G" & i + 1) & " " & .Range("H" & i + 1)
            End If
                If .Range("B" & i) = "Madame" Then ValCivil1 = "Mme" Else ValCivil1 = "M"
           
                If ValNom1 = ValNom2 Then 'c'est un couple
                    If .Range("B" & i + 1) = "Monsieur" Then ValCivil2 = "M" Else ValCivil1 = "Mme"
'                    ValCivil1 = ValCivil1
'                    ValCivil2 = ValCivil2
                    ValNom = .Range("A" & i) & " - " & ValCivil1 & " & " & ValCivil2 & " " & .Range("C" & i) & " " & _
                        Application.Proper(.Range("D" & i)) & " " & .Range("C" & i + 1) & " " & Application.Proper(.Range("D" & i + 1))
                    i = i + 1
                Else
                    ValNom = .Range("A" & i) & " - " & ValCivil1 & " " & .Range("C" & i) & " " & Application.Proper(.Range("D" & i))
                End If
                Nbetiquette = Nbetiquette + 1
                Ws2.Range(Col & Lig) = ValNom
                Ws2.Range(Col & Lig + 1) = .Range("E" & i)
                Ws2.Range(Col & Lig + 2) = .Range("F" & i)
                Ws2.Range(Col & Lig + 3) = .Range("H" & i) & " " & .Range("G" & i)
                'Ws2.Range(Col & Lig + 4) = .Range("H" & i)
               
                Lig = Lig + 8
                If Col = "A" Then
                    Col = "B": Lig = Lig - 8
                Else
                    Col = "A": Lig = Lig
                End If
               
                Cptr = Cptr + 1
                If Cptr = 16 * Nb Then Lig = Lig + 2: Nb = Nb + 1
           
        End If
    Next i
End With
 [ModuloTemp] = Nbetiquette Mod 28
End Sub

l'affichage avant impression resté une difficulté car difficile de prédire si l'impression à été effectué ou pas.

 

[jcf6464]

Bonjour,

Regarde la pièce jointe 1224841

Option Explicit

Private Sub CommandButton1_Click()
PrintPreview
If MsgBox("L'immpression c'es biepassé", vbQuestion + vbYesNo) = vbYes Then [Modulo] = [ModuloTemp]: [ModuloTemp] = 0
End Sub

Private Sub CommandButton2_Click()
PrintOut
[Modulo] = [ModuloTemp]: [ModuloTemp] = 0
End Sub

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim ValNom1$, ValNom2$, ValNom$, ValCivil1$, ValCivil2$
Dim Derlig&, i&, Lig&, Col$, Cptr&, Nb%
Dim Start As Integer, Nbetiquette As Integer
Start = [Modulo]
Set Ws1 = Worksheets("Feuil1")
Set Ws2 = Worksheets("Etiquette")

Ws2.Range("A:B").ClearContents
Derlig = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Col = "A": Lig = 1: Nb = 1
With Ws1
For Nbetiquette = 1 To Start
    If Nbetiquette Mod 2 = 0 Then Lig = Lig + 8
                If Col = "A" Then
                    Col = "B": ' Lig = Lig - 8
                Else
                    Col = "A": Lig = Lig
                End If
             
                Cptr = Cptr + 1
                If Cptr = 16 * Nb Then Lig = Lig + 2: Nb = Nb + 1
Next
Nbetiquette = Nbetiquette - 1
    For i = 2 To Derlig
        If .Rows(i).Hidden = False Then
            ValNom1 = .Range("C" & i) & " " & .Range("E" & i) & " " & .Range("G" & i) & " " & .Range("H" & i)
            If .Rows(i + 1).Hidden = True Then
                ValNom2 = ""
            Else
                ValNom2 = .Range("C" & i + 1) & " " & .Range("E" & i + 1) & " " & .Range("G" & i + 1) & " " & .Range("H" & i + 1)
            End If
                If .Range("B" & i) = "Madame" Then ValCivil1 = "Mme" Else ValCivil1 = "M"
         
                If ValNom1 = ValNom2 Then 'c'est un couple
                    If .Range("B" & i + 1) = "Monsieur" Then ValCivil2 = "M" Else ValCivil1 = "Mme"
'                    ValCivil1 = ValCivil1
'                    ValCivil2 = ValCivil2
                    ValNom = .Range("A" & i) & " - " & ValCivil1 & " & " & ValCivil2 & " " & .Range("C" & i) & " " & _
                        Application.Proper(.Range("D" & i)) & " " & .Range("C" & i + 1) & " " & Application.Proper(.Range("D" & i + 1))
                    i = i + 1
                Else
                    ValNom = .Range("A" & i) & " - " & ValCivil1 & " " & .Range("C" & i) & " " & Application.Proper(.Range("D" & i))
                End If
                Nbetiquette = Nbetiquette + 1
                Ws2.Range(Col & Lig) = ValNom
                Ws2.Range(Col & Lig + 1) = .Range("E" & i)
                Ws2.Range(Col & Lig + 2) = .Range("F" & i)
                Ws2.Range(Col & Lig + 3) = .Range("H" & i) & " " & .Range("G" & i)
                'Ws2.Range(Col & Lig + 4) = .Range("H" & i)
             
                Lig = Lig + 8
                If Col = "A" Then
                    Col = "B": Lig = Lig - 8
                Else
                    Col = "A": Lig = Lig
                End If
             
                Cptr = Cptr + 1
                If Cptr = 16 * Nb Then Lig = Lig + 2: Nb = Nb + 1
         
        End If
    Next i
End With
 [ModuloTemp] = Nbetiquette Mod 28
End Sub

l'affichage avant impression resté une difficulté car difficile de prédire si l'impression à été effectué ou pas.

bonsoir dysorthographie, sylvanu et le forum

Merci pour cette ébauche qui fonctionne sur ce classeur j'ai était jusqu’à 18 étiquettes en changeant le modulo,
Je vais l'intégrer dans le classeur final demain en attendant,
Pour l'impression je ne trouve pas de difficulté pour l'instant à voir,

bonne soirée bon appétit jcf

 

[jcf6464]

bonsoir dysorthographie, sylvanu et le forum

Merci pour cette ébauche qui fonctionne sur ce classeur j'ai était jusqu’à 18 étiquettes en changeant le modulo,
Je vais l'intégrer dans le classeur final demain en attendant,
Pour l'impression je ne trouve pas de difficulté pour l'instant à voir,

bonne soirée bon appétit jcf

bonsoir dysorthographie, sylvanu et le forum,
pour les essais sur classeur définitif cela fonctionne très bien une remarque, sur un tableau structurer si vous mettez la ligne total en bas cela génère une étiquette en plus en bas des autres ,

En deuxième temps l'on ma demander si je pouvez faire avec 3 colonnes d’étiquettes j'ai prépare la feuille des étiquettes mais je suis bloquer
pouvez vous voir merci, je joint le classeur,

cordialement jcf

 

[dysorthographie]

Bonsoir,
Il faut que tu revois les disposition des étiquettes car il y a une dérive dans la longueurs des pages au niveau de étiquette. ceci dit il faut que le nombre de lignes entre étiquettes reste invariable sinon ça devient ingérable.

pour la somme vue que dans mon fichier je n'ai pas d'exemple difficile d'imaginer!

'==============================================================================
' Procédure : Worksheet_Activate
' Description : Génère automatiquement des étiquettes d'adresse sur 3 colonnes
'               à partir des données de la feuille "Feuil1"
' Déclenchement : Lorsque la feuille "Etiquette3Col" est activée
'==============================================================================
Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False ' Désactive le rafraîchissement d'écran pour améliorer les performances
 
    ' === Déclaration des variables ===
    Dim Ws2 As Worksheet              ' Feuille destination des étiquettes
    Dim ValNom1$                       ' Nom complet temporaire (pour vérification)
    Dim ValNom$                        ' Nom formaté pour l'étiquette
    Dim ValCivil1$                     ' Civilité (M ou Mme)
    Dim i&                             ' Compteur de ligne source
    Dim Lig&                           ' Position de ligne dans la feuille destination
    Dim Col$                           ' Colonne destination (A, C ou E)
    Dim Nbetiquette As Integer         ' Compteur d'étiquettes générées
    Dim Planche As Long                ' Nombre total d'étiquettes par planche
    Dim Colonnnes()                    ' Tableau des colonnes disponibles
 
    ' === Initialisation ===
    Colonnnes() = Array("A", "C", "E")                    ' Définit les 3 colonnes pour les étiquettes
    Nbetiquette = [Strart]                                 ' Récupère la position de départ (cellule nommée "Strart")
    Planche = [NBétiqetteColonne] * [NbColonne]           ' Calcule le nombre d'étiquettes par planche
 
    ' === Configuration des feuilles ===
    Set Ws2 = Worksheets("Etiquette3Col")                 ' Feuille de destination
    Ws2.Range("A:E").ClearContents                        ' Efface le contenu précédent
 
    ' === Traitement des données ===
    With Worksheets("Feuil1")                             ' Feuille source des données
        ' Parcourt toutes les lignes de données (de la ligne 2 à la dernière ligne remplie)
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
       
            ' Traite uniquement les lignes visibles (non filtrées)
            If .Rows(i).Hidden = False Then
                ' Concatène nom, adresse, code postal et ville pour vérification
                ValNom1 = .Range("C" & i) & " " & .Range("E" & i) & " " & .Range("H" & i) & " " & .Range("G" & i)
           
                ' Détermine la civilité (M ou Mme) selon la colonne B
                If .Range("B" & i) = "Madame" Then
                    ValCivil1 = "Mme"
                Else
                    ValCivil1 = "M"
                End If
           
                ' Formate la ligne principale de l'étiquette :
                ' Numéro - Civilité Nom Prénom (avec mise en forme du prénom)
                ValNom = .Range("A" & i) & " - " & ValCivil1 & " " & _
                         .Range("C" & i) & " " & Application.Proper(.Range("D" & i))
           
                ' === Positionnement de l'étiquette ===
                Nbetiquette = Nbetiquette + 1                          ' Incrémente le compteur
           
                ' Détermine la colonne (A, C ou E) en fonction du numéro d'étiquette
                Col = Colonnnes((Nbetiquette - 1) Mod [NbColonne])
           
                ' Calcule la ligne de destination en fonction de :
                ' - La position dans la colonne (Nbetiquette - 1) Mod [NbColonne]
                ' - Le numéro de ligne d'étiquette dans la colonne
                ' - La taille d'une étiquette [TailleEtiquette]
                Lig = ((((Nbetiquette - 1) - ((Nbetiquette - 1) Mod [NbColonne])) / [NbColonne]) * [TailleEtiquette])
           
                ' === Remplissage de l'étiquette (4 lignes) ===
                Ws2.Cells(1, Col).Offset(Lig) = ValNom                              ' Ligne 1 : Numéro - Civilité Nom Prénom
                Ws2.Cells(1, Col).Offset(Lig + 1) = .Range("E" & i)                 ' Ligne 2 : Adresse
                Ws2.Cells(1, Col).Offset(Lig + 2) = .Range("F" & i)                 ' Ligne 3 : Complément d'adresse
                Ws2.Cells(1, Col).Offset(Lig + 3) = .Range("H" & i) & " " & .Range("G" & i)  ' Ligne 4 : Code postal + Ville
            End If
        Next i
    End With
 
    ' === Sauvegarde de la position ===
    ' Sauvegarde la position modulo planche pour reprendre au bon endroit lors du prochain traitement
    [Strart] = Nbetiquette Mod Planche
End Sub