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

1 Respuesta

4.530.400 pts. Sancho, si los perros ladran ...

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:=wdFormatOriginalFormatting

Lo 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!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas