Création d'étiquettes d'adresse à partir d'une feuille de calcul
Exemple de code fourni par : Bill Jelen, MrExcel.com
L’exemple de code suivant prend une liste d’adresses contenant une adresse par ligne et les copie dans une autre feuille, en les organisant de manière à tenir sur des étiquettes d’adresse imprimables. Le classeur doit contenir deux feuilles, une nommée « Adresses » et une nommée « Étiquettes ». Les adresses de la feuille Adresses doivent être disposées à raison d’une adresse par ligne, avec le nom dans la colonne A, la ligne d’adresse 1 dans la colonne B, la ligne d’adresse 2 dans la colonne C et la ville, l’État, le pays/la région et le code postal dans la colonne D. Les adresses sont réorganisées et copiées dans la feuille Étiquettes.
Sub CreateLabels()
' Clear out all records on Labels
Dim LabelSheet As Worksheet
Set LabelSheet = Worksheets("Labels")
LabelSheet.Cells.ClearContents
' Set column width for labels
LabelSheet.Cells(1, 1).ColumnWidth = 35
LabelSheet.Cells(1, 2).ColumnWidth = 36
LabelSheet.Cells(1, 3).ColumnWidth = 30
' Loop through all records
Dim AddressSheet As Worksheet
Set AddressSheet = Worksheets("Addresses")
FinalRow = AddressSheet.Cells(65536, 1).End(xlUp).Row
If FinalRow > 1 Then
NextRow = 1
NextCol = 1
For i = 2 To FinalRow
' Set up row heights
If NextCol = 1 Then
LabelSheet.Cells(NextRow, 1).Resize(4, 1).RowHeight = 15.25
LabelSheet.Cells(NextRow + 4, 1).RowHeight = 13.25
End If
' Put the Name in row 1
ThisRow = NextRow
LabelSheet.Cells(ThisRow, NextCol).Value = AddressSheet.Cells(i, 1) & " " & AddressSheet.Cells(i, 7)
' Put the Address Line 1 in row 2
If AddressSheet.Cells(i, 2).Value > "" Then
ThisRow = ThisRow + 1
LabelSheet.Cells(ThisRow, NextCol).Value = AddressSheet.Cells(i, 2)
End If
' Put the Address Line 2 in row 3
If AddressSheet.Cells(i, 3).Value > "" Then
ThisRow = ThisRow + 1
LabelSheet.Cells(ThisRow, NextCol).Value = AddressSheet.Cells(i, 3)
End If
' Put the City, State, Country/Region and Postal code in row 4
If AddressSheet.Cells(i, 4).Value > "" Then
CitySt = AddressSheet.Cells(i, 4)
End If
ThisRow = ThisRow + 1
LabelSheet.Cells(ThisRow, NextCol).Value = CitySt
' Update the row and column for the next label
If NextCol = 1 Then
NextCol = 2
ElseIf NextCol = 2 Then
NextCol = 3
Else
NextCol = 1
NextRow = NextRow + 5
End If
Next i
LabelSheet.Activate
Else
MsgBox "No records match the criteria"
End If
End Sub
À propos du collaborateur
MVP Bill Jelen est l’auteur de plus de deux douzaines livres sur Microsoft Excel. Il est invité régulièrement sur TechTV avec Leo Laporte et il est l’hôte de MrExcel.com qui inclut plus de 300 000 questions et réponses sur Excel.
Assistance et commentaires
Avez-vous des questions ou des commentaires sur Office VBA ou sur cette documentation ? Consultez la rubrique concernant l’assistance pour Office VBA et l’envoi de commentaires afin d’obtenir des instructions pour recevoir une assistance et envoyer vos commentaires.
Commentaires
https://aka.ms/ContentUserFeedback.
Bientôt disponible : Tout au long de 2024, nous allons supprimer progressivement GitHub Issues comme mécanisme de commentaires pour le contenu et le remplacer par un nouveau système de commentaires. Pour plus d’informations, consultezEnvoyer et afficher des commentaires pour