Crear etiquetas de dirección a partir de una hoja de cálculo
Código de ejemplo proporcionado por: Bill Jelen, MrExcel.com
En el ejemplo de código siguiente se toma una lista de direcciones organizadas como una dirección por fila y se copian en otra hoja y se organizan para que quepan en etiquetas de direcciones imprimibles. El libro debe contener dos hojas, una denominada "Addresses" y otra denominada "Labels". Las direcciones de la hoja Direcciones deben organizarse como una dirección por fila, con el nombre en la columna A, la línea de dirección 1 en la columna B, la línea de dirección 2 en la columna C y el código city, state, country/region y postal en la columna D. Las direcciones se reorganizan y copian en la hoja Etiquetas.
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
Acerca del colaborador
Bill Jelen, MVP, es autor de más de veinticinco libros sobre Microsoft Excel. Es invitado habitual en TechTV con Leo Laporte y es el administrador de MrExcel.com, un sitio web que incluye más de 300 000 preguntas y respuestas sobre Excel.
Soporte técnico y comentarios
¿Tiene preguntas o comentarios sobre VBA para Office o esta documentación? Vea Soporte técnico y comentarios sobre VBA para Office para obtener ayuda sobre las formas en las que puede recibir soporte técnico y enviar comentarios.
Comentarios
https://aka.ms/ContentUserFeedback.
Próximamente: A lo largo de 2024 iremos eliminando gradualmente GitHub Issues como mecanismo de comentarios sobre el contenido y lo sustituiremos por un nuevo sistema de comentarios. Para más información, vea:Enviar y ver comentarios de