Generar Word con datos de Excel e insertar imágenes al final
Con varios UF genero un informe médico en 160 col de una fila de excel. Al final, abro una plantilla de Word y genero un informe. Hasta acá funciona todo perfecto.
Pero le quiero agregar IMÁGENES que están en otra hoja de excel.
Envío la macro que tengo para los textos... Me faltan las imágenes. ¿Cómo se hace?
Dim datos(0 To 1, 0 To 44) As String '(columna,fila)
patharch = ThisWorkbook.Path & "\INFORME HEC.dotx"
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
On Error Resume Next
datos(0, 0) = "[AÑO]"
datos(1, 0) = Hoja2.Cells(3, 1) 'datos(columna,fila) = Hoja2.cells(fila,columna)
datos(0, 1) = "[MOTIVO]"
datos(1, 1) = Hoja2.Cells(3, 14)
datos(0, 2) = "[EDAD]"
datos(1, 2) = Hoja2.Cells(3, 6)
datos(0, 3) = "[PESO]"
datos(1, 3) = Hoja2.Cells(3, 7)
datos(0, 4) = "[TALLA]"
datos(1, 4) = Hoja2.Cells(3, 8)
datos(0, 5) = "[SC]"
datos(1, 5) = Hoja2.Cells(3, 9)
datos(0, 6) = "[1]"
datos(1, 6) = Hoja2.Cells(3, 37)
datos(0, 7) = "[2]"
datos(1, 7) = Hoja2.Cells(3, 38)
datos(0, 8) = "[3]"
datos(1, 8) = Hoja2.Cells(3, 40)
datos(0, 9) = "[4]"
datos(1, 9) = Hoja2.Cells(3, 42)
datos(0, 10) = "[5]"
datos(1, 10) = Hoja2.Cells(3, 44)
datos(0, 11) = "[6]"
datos(1, 11) = Hoja2.Cells(3, 39)
datos(0, 12) = "[7]"
datos(1, 12) = Hoja1.Cells(3, 41)
datos(0, 13) = "[8]"
datos(1, 13) = Hoja2.Cells(3, 43)
datos(0, 14) = "[9]"
datos(1, 14) = Hoja2.Cells(3, 45)
datos(0, 15) = "[10]"
datos(1, 15) = Hoja2.Cells(3, 46)
datos(0, 16) = "[11]"
datos(1, 16) = Hoja2.Cells(3, 47)
datos(0, 17) = "[12]"
datos(1, 17) = Hoja2.Cells(3, 49)
datos(0, 18) = "[13]"
datos(1, 18) = Hoja2.Cells(3, 51)
datos(0, 19) = "[14]"
datos(1, 19) = Hoja2.Cells(3, 48)
datos(0, 20) = "[15]"
datos(1, 20) = Hoja2.Cells(3, 50)
datos(0, 21) = "[16]"
datos(1, 21) = Hoja2.Cells(3, 52)
datos(0, 22) = "[17]"
datos(1, 22) = Hoja2.Cells(3, 54)
datos(0, 23) = "[18]"
datos(1, 23) = Hoja2.Cells(3, 56)
datos(0, 24) = "[19]"
datos(1, 24) = Hoja2.Cells(3, 58)
datos(0, 25) = "[20]"
datos(1, 25) = Hoja2.Cells(3, 60)
datos(0, 26) = "[21]"
datos(1, 26) = Hoja2.Cells(3, 62)
datos(0, 27) = "[22]"
datos(1, 27) = Hoja2.Cells(3, 63)
datos(0, 28) = "[23]"
datos(1, 28) = Hoja2.Cells(3, 64)
datos(0, 29) = "[24]"
datos(1, 29) = Hoja2.Cells(3, 65)
datos(0, 30) = "[25]"
datos(1, 30) = Hoja2.Cells(3, 66)
datos(0, 31) = "[26]"
datos(1, 31) = Hoja2.Cells(3, 67)
datos(0, 32) = "[27]"
datos(1, 32) = Hoja2.Cells(3, 68)
datos(0, 33) = "[28]"
datos(1, 33) = Hoja2.Cells(3, 69)
datos(0, 34) = "[29]"
datos(1, 34) = Hoja2.Cells(3, 70)
datos(0, 35) = "[DESCRIPCION]"
datos(1, 35) = Hoja2.Cells(3, 159)
datos(0, 36) = "[CONCLUSIONES]"
datos(1, 36) = Hoja2.Cells(6, 160)
datos(0, 37) = "[MES]"
datos(1, 37) = Hoja2.Cells(3, 2) 'datos(columna,fila) = Hoja1.cells(fila,columna)
datos(0, 38) = "[DIA]"
datos(1, 38) = Hoja2.Cells(3, 3) 'datos(columna,fila) = Hoja1.cells(fila,columna)
datos(0, 39) = "[NOMBRE]"
datos(1, 39) = Hoja2.Cells(3, 4) 'datos(columna,fila) = Hoja1.cells(fila,columna)
datos(0, 40) = "[TELEFONO]"
datos(1, 40) = Hoja2.Cells(3, 10) 'datos(columna,fila) = Hoja1.cells(fila,columna)
datos(0, 41) = "[MEDICO]"
datos(1, 41) = Hoja2.Cells(3, 15) 'datos(columna,fila) = Hoja1.cells(fila,columna)
datos(0, 42) = "[OS]"
datos(1, 42) = Hoja2.Cells(3, 18) 'datos(columna,fila) = Hoja1.cells(fila,columna)
datos(0, 43) = "[HC]"
datos(1, 43) = Hoja2.Cells(3, 13) 'datos(columna,fila) = Hoja1.cells(fila,columna)
For i = 0 To UBound(datos, 2)
textobuscar = datos(0, i)
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
While objWord.Selection.Find.Found = True
objWord.Selection.Text = datos(1, i) 'texto a reemplazar
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
Wend
Next i
objWord.Activate
End Sub
1 Respuesta
Cambia en tu macro esta línea
ObjWord. Activate
Por estas:
'copia la imagen de la hoja3
Sheets("Hoja3"). DrawingObjects("1 imagen"). Copy
ObjWord. Activate
objWord.Selection.PasteAndFormat Type:=wdFormatOriginalFormattingLo que hace es copiar la imagen con el nombre "1 imagen" que se encuentra en la hoja "hoja3" y la pega en el documento word.
De esa forma puedes pegar imágenes.
Hola Dante. Gracias por la pronta respuesta. Insertó la imagen perfectamente... pero lo hizo en la primera línea del documento. Necesito que las imágenes aparezcan al final, después del texto y mi firma. Es perfecto en combinación con la otra ayuda que me diste para insertar imágenes en la hoja de excel. Tuve que cambiar el nombre de la imagen por "figura 1".
Abajo te envío la macro para insertar imagen en la hoja de excel. Obviamente desarrollada por una persona que entiende del tema
Private Sub CommandButton1_Click()
'Por.Dante Amor
Hoja10.Select
ruta = "Bm1" 'celda en donde se pondrá la ruta
imagen = "g6:ag32" 'celda en donde se pondrá la imagen
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de imagen"
.Filters.Clear
.Filters.Add "Todos los archivos", "*.*"
.Filters.Add "*.jpg", "*.jpg"
.Filters.Add "*.bmp", "*.bmp"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path & ("\IMAGENES DESDE RADIANT") & "\IMAGENES HEC"
'.Show
If .Show Then
ARCHIVO1 = .SelectedItems.Item(1)
pos = InStrRev(ARCHIVO1, "\")
wruta = Left(ARCHIVO1, pos)
ActiveSheet.pictures.Insert(ARCHIVO1).Select
'arr = Range(imagen).Top
'izq = Range(imagen).Left
'hei = Range(imagen).Height
'wid = Range(imagen).Width
On Error Resume Next
ActiveSheet.DrawingObjects("figura1").Delete
On Error GoTo 0
With Selection
Selection.ShapeRange.ZOrder msoSendToBack
.Name = "figura1"
.Placement = xlMoveAndSize
.PrintObject = True
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Top = Range(imagen).Top
.ShapeRange.Left = Range(imagen).Left
.ShapeRange.Height = Range(imagen).Height
.ShapeRange.Width = Range(imagen).Width
'.ShapeRange.Name = ARCHIVO1
End With
Range("g6").ShrinkToFit = True
End If
End With
Application.ScreenUpdating = True
Image1.Picture = LoadPicture(ARCHIVO1, 3, 3, Default)
End Sub
Esta es una opción para pegar la imagen al final del documento.
Edita tu plantilla y al final de tu documento escribe la palabra "InsertarImangen" o en el lugar de tu documento en donde quieras que sea insertada la imagen.
Entonces quedará así:
'copia la imagen de la hoja3
Sheets("Hoja3"). DrawingObjects("1 imagen"). Copy
ObjWord. Activate
objWord.Selection.Find.Execute FindText:="InsertarImagen"
objWord.Selection.PasteAndFormat Type:=wdFormatOriginalFormatting.
.
¡Gracias!
Dante: IMPECABLE! Es exactamente lo que necesitaba. Como siempre, tu colaboración dio en el clavo. Millón de gracias!
Hola Dante. Un tiempo despues sigo usando esta macro y es perfecta. Salvo porque tengo que guardar el documento como PDF ya que las imágenes JPEG siguen vinculadas a la carpeta, que es una carpeta temporal: para cada archivo word, las imágenes de la carpeta se eliminan. Como puedo insertar esas imágenes desvinculadas? cual es la orden para que en vez de INSERT, pueda utilizar ADDPICTURE y darle la orden "inktofile:=msoFalse" y "savewithdocument:=msoCTrue"?
Desde ya. Muchas gracias
Ho la Pablo:
Visita mi canal
Excel y macros
Te refieres al insert en excel o en word.
Si es para el excel no conozco otra instrucción para insertar imágenes o para desvincularlas.
Pero realiza lo siguiente, activa la grabadora de macros, inserta la imagen, realiza la desvinculación o revisa cuál es la forma que necesitas para insertarla sin que esté vinculada. Entonces detienes la macro. Copia la macro y la pegas aquí y te ayudo a adaptarla a tu código.
Recomendaciones:
Cambiar a mayúsculas en automático y poner fecha en automático - YouTube
Función sumaproducto - YouTube
Curso de macros. Consejos para empezar a programar. - YouTube
Sal u dos Dante Amor
