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 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
| Sub etiquette22x144()
'Mise à Zéro des noms de plage
'"ActiveSheet.Unprotect ("etiquette")
'"Sheets("Feuil4").Select
'"ActiveSheet.Names("publipost").Delete
'"Sheets("Feuil1").Select
'"ActiveSheet.Protect ("etiquette")
'Sélection de la feuille de paramètre
Sheets("Feuil1").Select
'Définition des variables
ACTI = Range("C5").Value
ZONE = Range("C7").Value
ALLEE1 = Range("C9").Value
ALLEE2 = Range("G9").Value
DEPL1 = Range("C11").Value
DEPL2 = Range("G11").Value
NIV1 = Range("C13").Value
NIV2 = Range("G13").Value
x = Range("L9").Value
y = Range("L11").Value
Z = Range("L13").Value
'Sélection de la feuille de calcul
Sheets("Feuil2").Select
Cells.Select
Selection.ClearContents
Sheets("Feuil3").Select
Rows("1:2").Select
Selection.Copy
Sheets("Feuil2").Select
Rows("1:1").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A2").Select
For allee = ALLEE1 To ALLEE2 Step x
For depl = DEPL1 To DEPL2 Step y
For niv = NIV1 To NIV2 Step Z
ActiveCell.Value = ACTI
ActiveCell.Offset(, 1).Select
ActiveCell.Value = ZONE
ActiveCell.Offset(, 1).Select
ActiveCell.Value = allee
ActiveCell.Offset(, 1).Select
ActiveCell.Value = depl
ActiveCell.Offset(, 1).Select
ActiveCell.Value = niv
ActiveCell.Offset(1, -4).Select
Next niv
Next depl
Next allee
'Copie des formules pour code128
der = Range("A50000").End(xlUp).Row
Range("F2:O2").Select
Selection.AutoFill Destination:=Range("F2:O" & der)
'Copie du tableau
Sheets("Feuil4").Select
Cells.Select
Selection.ClearContents
Sheets("Feuil2").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Feuil4").Select
Range("A1").Select
ActiveSheet.Paste
'"Dim DerLig As Long, DerCol As String
'" DerLig = Range("A1").End(xlDown).Row
'" Range("A1").End(xlToRight).Select
'" n = ActiveCell.Address
'" DerCol = Right(Left(n, 2), 1)
'" ActiveSheet.Names.Add Name:="publipost", RefersTo:=Range("A1:" & DerCol & DerLig)
'" ActiveSheet.Names("publipost").Comment = ""
Sheets("Feuil1").Select
Range("A1").Select
'Ouverture de Word
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
' Ouverture de la fenêtre de sélection du fichier pour le publipostage dans le répertoire C:\etiquette2\
Dim dlg As FileDialog
Dim strPath As String
Set dlg = WordApp.FileDialog(msoFileDialogFilePicker)
With dlg
.InitialFileName = "C:\etiquette2\"
.AllowMultiSelect = False
.Title = "ouvrir"
.Show
End With
strPath = dlg.SelectedItems(1)
Set WordDoc = WordApp.Documents.Open(strPath)
' Publipostage à partir des données de la feuil4 du fichier macro etiquette.xlsm situé dans le répertoire C:\etiquette2\
' lignes à remplacer dans le texte ci-dessous pour utiliser la plage "publipost"
' , SQLStatement:="SELECT * FROM 'publipost'", SQLStatement1:="", SubType:= _
' , SQLStatement:="SELECT * FROM 'Feuil4$'", SQLStatement1:="", SubType:= _
ActiveDocument.MailMerge.MainDocumentType = wdMailingLabels
ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\etiquette2\macro etiquette.xlsm", _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\etiquette2\macro etiquette.xlsm;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=" _
, SQLStatement:="SELECT * FROM 'Feuil4$'", SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
' Fermeture du fichier de base du publipostage
WordDoc.Close False
' Fermeture du fichier Excel (macro etiquette.xlsm) et suppression des fenêtres d'alerte lors de la fermeture
Application.DisplayAlerts = False
Application.CutCopyMode = False
ActiveWorkbook.Close True
End Sub |
Partager