Macro en Excel para llenar plantilla de Word
Necesito de su apoyo, tengo una serie de datos en una hoja Excel y necesito llevarlos a una plantilla en word a través e una macro.
Me pasaron una macro pero hay que ir generando uno a uno cada registro ya que hay que ir seleccionar uno a uno y dar click al botón generar y lo que necesito es que de una sola vez al dar click al botón generar me genere todos los comprobantes, si es posible 3 comprobantes por pagina de Word para ahorrar papel.
Este es un ejemplo de la base de Excel la cual puede tener n cantidad de registros
Hoja Parámetros
Código de la macro
Sub Generar()
Dim objWord As Word.Application
Set a = Sheets("Parametros")
'Ubicacion y nombre de plantilla
wArch = a.Range("D3").Text & a.Range("D2").Text & ".docx"
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Add template:=wArch, NewTemplate:=False, DocumentType:=0
For i = 1 To a.Range("D1").Value 'Celda donde esta el total de variables
datos = a.Range("B" & i) 'Donde estan los datos
reemp = a.Range("A" & i) 'Donde estan las etiquetas
'Utilizamos buscar y reemplazar en Word
With objWord.Selection.Find
.Text = datos 'Busca el texto de datos
.Replacement.Text = reemp 'Reemplaza por el texto
.Execute Replace:=2 ' La variable en 2 es para reemplazar todos los valores
End With
Next i
objWord.Activate
End Sub
Esta es la plantilla del comprobante
1 Respuesta
Desconozco cómo se haría para realizar todos los recibos en un solo documento de word.
Revisa si lo siguiente te ayuda.
Se va a generar un archivo por cada Nota de Abono.
El archivo se guardará con el nombre del beneficiario.
Los archivos se guardarán en la misma carpeta donde tienes la plantilla word.
Sub GenerarArchivos()
'Act Por Dante Amor
Dim sh1 As Worksheet, sh2 As Worksheet
Dim objWord As Word.Application
Dim i As Long, j As Long
Dim wArch As String, ruta As String, nombre As String
Dim datos As Variant, reemp As Variant
'
Application.ScreenUpdating = False
'
Set sh1 = Sheets("Datos") 'Nombre de la hoja con los datos
Set sh2 = Sheets("Parametros")
'Ubicacion y nombre de plantilla
wArch = sh2.Range("D3").Text & sh2.Range("D2").Text & ".docx"
ruta = sh2.Range("D3").Text 'Carpeta donde se guardan los archivos
'
'Para cada registro de la hoja con datos
For j = 2 To sh1.Range("B" & Rows.Count).End(3).Row
Set objWord = CreateObject("Word.Application")
'objWord.Visible = True
objWord.Documents.Add template:=wArch, NewTemplate:=False, DocumentType:=0
'
nombre = sh1.Range("B" & j).Value 'nombre del archivo
sh2.Range("A1").Value = sh1.Range("B" & j).Value
sh2.Range("A2").Value = sh1.Range("C" & j).Value
sh2.Range("A3").Value = sh1.Range("D" & j).Value
sh2.Range("A4").Value = sh1.Range("F" & j).Value
sh2.Range("A5").Value = sh1.Range("G" & j).Value
sh2.Range("A6").Value = sh1.Range("A" & j).Value
sh2.Range("A7").Value = sh1.Range("E" & j).Value
'
For i = 1 To sh2.Range("D1").Value 'Celda donde esta el total de variables
datos = sh2.Range("B" & i).Value 'Donde estan los datos
reemp = sh2.Range("A" & i).Value 'Donde estan las etiquetas
'
'Utilizamos buscar y reemplazar en Word
With objWord.Selection.Find
.Text = datos 'Busca el texto de datos
.Replacement.Text = reemp 'Reemplaza por el texto
.Execute Replace:=2 ' La variable en 2 es para reemplazar todos los valores
End With
Next i
'
'objWord.Activate
ObjWord. ActiveDocument.SaveAs ruta & nombre
objWord. ActiveDocument. Close
objWord. Quit
Next
'
Application.ScreenUpdating = True
End Sub
Te agradezco mucho Dante Amor, eres muy amable
Me sirvió mucho
Dante disculpa, como seria si quisiera que los comprobantes fueran en formato PDF
Te invito a SUSCRIBIRTE a mi canal de YouTube:
Ahí encontrarás más sobre Excel y Macros:
Comparte los enlaces en tus redes sociales.
Sal u dos
