Discussion :

[chingilou]

bonjour
j'ai un tableau à 3 colonnes N° - Désignation et Quantité
le tableau s’étend de A10 à A196 (variable)
je voudrais créer une macro qui me créera dans la feuille2 des formes (rectangles à coins arrondis H:1.5cm L:6cm) avec comme données textes A1&"--"&B1&"--("&y&"/"C1&")", y de 1 à C1.
Le but final c'est d'imprimer la feuille2 sur un autocollant, couper les formes et les coller sur les boites (pour plus de clarté pour la livraison)

N°	désig	Qté
1	article 01	2
2	article 02	3
3	article 03	2

j’espère que je n'ai pas était vague
l'exemple joint est mon but

[78chris]

Bonjour

Ne serait-il pas plus simple de créer ces texte dans des cellules et de publiposter sur des planches d'étiquettes autocollantes aux dimensions adéquates ?

[chingilou]

merci 78chris
je vais essayer de créer la liste en textes (j’espère)
mais pour publiposter je ne sais pas ce que s'est

[78chris]

RE

C'est utiliser Word qui va lire les lignes du fichier Excel et remplir une étiquette automatiquement par ligne en mode publipostage.

Si tu donnes la taille des étiquettes et le nombre d'étiquettes en largeur et en hauteur, on peut te faire une modèle

[Patrice740]

Bonjour,

Des étiquettes à coin arrondi de 60 x 15 mm ça n'existe que sur mesure !

La dimension standard qui s'en rapproche est 63,5 x 29,7 mm (mais c'est le double en hauteur)

En rectangulaire il existe 70 x 16,9 mm qui est plus proche (Avery 3420 ou Apli Agipa 118993)

En utilisant un tableau structuré nommé "Produits" pour les données et une feuille "Liste étiquettes" pour les étiquettes :
- voici une macro qui crée automatiquement un document Word, résultat d'un publipostage de tes données sur une (des) planches d'étiquettes Avery 3420.
- Il n'y a plus qu'à lancer l'impression : il faut toujours éviter de le faire automatiquement par macro, il vaut mieux un petit clic qu'un grand clac !.

La Macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Option Explicit
Sub Etiquettes()
Dim tbl As ListObject
Dim rng As Range
Dim lig As ListRow
Dim nom As Name
Dim apW As Object
Dim doc As Object
Dim tmp As Object
Dim wrg As Object
Dim qte As Variant
Dim txt As String
Dim cnx As String
Dim nbL As Long
  Worksheets("Liste étiquettes").Cells.Clear
  For Each nom In ThisWorkbook.Names
    If nom.Name = "Etiquettes" Then nom.Delete
  Next nom
  Set tbl = Range("Produits").ListObject
  Set rng = Worksheets("Liste étiquettes").Range("A1")
  rng.Value = "Etiquettes"
  qte = Range("Produits[Qté]").Value
  For Each lig In tbl.ListRows
    For nbL = 1 To qte(lig.Index, 1)
      Set rng = rng.Offset(1)
      txt = lig.Range(1, 1).Value
      txt = txt & " -- " & lig.Range(1, 2).Value & " -- "
      txt = txt & "(" & nbL & "/" & lig.Range(1, 3).Value & ")"
      rng.Value = txt
    Next nbL
  Next lig
  Set rng = Worksheets("Liste étiquettes").Range("A1").CurrentRegion
  rng.EntireColumn.AutoFit
  ThisWorkbook.Names.Add "Etiquettes", rng, True
  Set apW = CreateObject("Word.Application")
  With apW
    .DisplayAlerts = True  'False
    .Visible = False
  End With
  Set tmp = apW.Documents.Add
  Set doc = apW.MailingLabel.CreateNewDocument(Name:="3420")
  tmp.Close False
  With doc
    Set wrg = .Content
    With wrg
      With .Tables(1).Range
        .Cells.VerticalAlignment = 1  ' wdCellAlignVerticalCenter
        .Paragraphs.Alignment = 1     ' wdAlignParagraphCenter
        .Font.Size = 18
        .Font.Bold = True
      End With
      .EndOf Unit:=6                  ' wdStory
      .EndOf Unit:=1, Extend:=1       ' wdCharacter , wdExtend
      .Font.Size = 2
      .StartOf Unit:=6                ' wdStory
    End With
    With .MailMerge
      .MainDocumentType = 1           ' wdMailingLabels
      .OpenDataSource Name:=ThisWorkbook.FullName, _
                      SQLStatement:="SELECT * FROM `Etiquettes`", _
                      SQLStatement1:="", SubType:=1                               ' wdMergeSubTypeAccess
    End With
    doc.Fields.Add Range:=apW.Selection.Range, Type:=59, Text:="""Etiquettes"""   ' Type:=wdFieldMergeField
    apW.WordBasic.MailMergePropagateLabel
    With .MailMerge
      .Destination = 0                ' wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = 1              ' wdDefaultFirstRecord
        .LastRecord = -16             ' wdDefaultLastRecord
      End With
      .Execute Pause:=False
    End With
    .Close False
  End With
  With apW
    .Visible = True
    .WindowState = 1                  ' wdWindowStateMaximize
    .Activate
  End With
End Sub

Le Fichier : Publipostage.xlsm

[78chris]

Bonjour Patrice

La demande initiale était d'imprimer sur une page et découper

Word permet de dimensionner à volonté les étiquettes et d'utiliser cutter ou massicot

De toute façon cette même demande a été postée ailleurs donc j'ai laissé tomber... et de toute évidence le demandeur ne repassera pas

[chingilou]

Bonjour Patrice

La demande initiale était d'imprimer sur une page et découper

Word permet de dimensionner à volonté les étiquettes et d'utiliser cutter ou massicot

De toute façon cette même demande a été postée ailleurs donc j'ai laissé tomber... et de toute évidence le demandeur ne repassera pas

bonjour 78chris et merci a toi et à patrice
désolé de mon absence j'étais absent et quasiment sans connexion
mais le hic et que je n'ai pas été signalé à mon émail lorsque vous avez répondu bizarre bizarre !???
serte le publipostage je ne connaissais pas et un certain sylvanu sur un autre forum m'as servi une macro d'enfers
en tout cas merci encore à toi et a patrice