Como insertar una imagen a través de una macro

¿Es posible insertar una imagen a través de una macro?

O como puedo hacer, par que al combinar correspondencia de excel a word, ¿se inserte en automático una imagen en cada carta generada?

¿Te encargo el correo que te envíe?

1 respuesta

Respuesta
1

Podemos probar con esta macro, pero envíame un ejemplo de documento de word, te tu excel y de un par de imágenes.

Sub CorrespondenciaConWord()
'Por.Dante Amor
    '
    patharch = ThisWorkbook.Path & "\plantilla1.dotx"
    '
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = True
        objWord.documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
        '
        For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
            textobuscar = Cells(1, j)
            objWord.Selection.Move 6, -1
            objWord.Selection.Find.Execute FindText:=textobuscar
            '
            While objWord.Selection.Find.found = True
                objWord.Selection.Text = Cells(i, j) 'texto a reemplazar
                objWord.Selection.Move 6, -1
                objWord.Selection.Find.Execute FindText:=textobuscar
            Wend
            '
        Next
        '
        ObjWord. Activate
        ObjWord. ActiveDocument.SaveAs Cells(i, "A").Value
        objWord. ActiveDocument. Close
 objWord. Quit
    Next
End Sub

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Marcos Masri” y el título de esta pregunta.

Hola Dante. Me da gusto saludarte de nuevo.

No se si recuerdes el archivo de excel Infracciones... 

Lo que estoy haciendo, es copiar y pegar "las ultimas" filas agregadas en un nuevo archivo llamado cartas, para después en word poder combinar la correspondencia, y que se generen las cartas de las infracciones.

Esa generación, la voy a probar ahora con la macro y procedimiento que me acabas de enviar, que ya habías hecho...

Lo que me refiero en esta pregunta, es que si es posible que se inserte también la imagen en la carta?

Te envío los documentos que utilizo actualmente a tu mail.

El de infracciones se llama ahora bitácora.

Te envio las imagenes, lo que no se, es como hacerle para "referenciarla"... tal vez poniendo el nombre del archivo de la imagen en una celda de excel?

Muchas gracias, 

Hola Dante, ¿recibiste mi archivo y mi pregunta? Te lo mande hace varios días, pero ya no obtuve ninguna respuesta... Saludos

La imagen es particular para cada documento es una sola imagen para todos los documentos, si solamente es una imagen, la puedes poner en la plantilla.

Hola!

la imagen va de acuerdo a cada fila del archivo.

El nombre del archivo de la imagen se compone de:

fecha "aaaammdd"

hora "hhmm"

Depto

ej: 201502212354505

dos mil quince el año

cero dos el mes de febrero

veintinuno el dia

veintitres cuarenta y cinco la hora

quinientos cinco el departameto

en la nueva columna que agregamos va la hora... Me parece que es la columna D del nuevo archivo que te envie

La la idea es insertar la imagen de acuerdo a la fila en el archivo de word, no se si se pueda como se inserta el demás texto?

Y la macro que genera el archivo de word, solo lo hace para la primera fila...

como lo puedo hacer para la que este seleccionada? O en la que este parado?

1. El nombre de archivo ya lo generé

2. Tienes que explicarme esto: "La la idea es insertar la imagen de acuerdo a la fila", cuáles imágenes, cómo se llaman los archivo, cómo lo relaciono, en dónde se va a insertar la imagen.?

3. Tienes que decirme, ¿qué mensaje de error te aparece? Y en qué parte de la macro se detiene, si estás en word, regresa a vba y revisa el error que te envía

Sub CorrespondenciaConWord()
'Por.Dante Amor
    '
    patharch = ThisWorkbook.Path & "\cartas.dotx"
    ruta = ThisWorkbook.Path & "\"
    '
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = True
        objWord.documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
        '
        For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
            textobuscar = Cells(1, j)
            objWord.Selection.Move 6, -1
            objWord.Selection.Find.Execute FindText:=textobuscar
            '
            While objWord.Selection.Find.found = True
                objWord.Selection.Text = Cells(i, j) 'texto a reemplazar
                objWord.Selection.Move 6, -1
                objWord.Selection.Find.Execute FindText:=textobuscar
            Wend
            '
        Next
        '
        ObjWord. Activate
        objWord.ActiveDocument.SaveAs ruta & Format(Cells(i, "A"), "yyyymmdd") & Format(Cells(i, "D"), "hh:mm") & Cells(i, "E")
        ObjWord. ActiveDocument. Close
        ObjWord. Quit
    Next
End Sub

Hola Dante.

Esta perfecto el archivo que me envías, solo hace falta añadir la hora al nombre del archivo que se genera. El dato de la hora lo obtienes de la columna "D". Es importante porque  si un mismo departamento tiene 2 infracciones o mas el mismo día, es la única manera de relacionar la imagen que requiero poder insertar en la plantilla. 

Cada archivo de word que se genera lleva una imagen diferente como la que te envío de ejemplo.

El nombre del archivo de la imagen, lo manejamos asi: fecha "aaaammdd" hora "hhmm" Depto

ej: 201502212354505

dos mil quince: el año

cero dos: el mes de febrero

veintinuno: el dia

veintitres cuarenta y cinco: la hora

quinientos cinco: el departameto

La fecha la tienes en la columna "A".

La hora la tienes en la columna "D".

El departamento lo tienes en la columna "E"

Las imagenes las organizamos en carpetas por Servidores (1,2,3) y lo tienes en la columna "B"

Crees que puedas de acuerdo a esa información, insertar la imagen que este en la carpeta de acuerdo al servidor, de acuerdo al nombre del archivo?

O como me propones poder hacerlo?

La imagen se inserta en la segunda hoja de la plantilla, te mando la imagen..

Y otra cosa, puedes hacer que al ejecutar la macro, solo realice los archivos de la fila en donde estoy ubicado?

Es decir, si estoy parado en A11, solo genera la fila 11. Porque ahorita generó todo lo que estaba, pero como eso va incrementando, no tiene caso que cada vez vuelva a generar las que ya generó anteriormente.

Ya te pone la hora, pero la columna la tienes vacía.

En las últimas ya tienen hora...

las primeras no la tienen porque no existía la columna... Pero ya todas van con ese dato llenado...

A lo que me refiero es que la macro tiene esto:

objWord.ActiveDocument.SaveAs ruta & Format(Cells(i, "A"), "yyyymmdd") & Format(Cells(i, "D"), "hh:mm") & Cells(i, "E")

Tiene la columna "A", la "D" y la "E"

Esta perfecto!

solo me falta la imagen...

Porque en la fila viene la fecha en la columna "A" con la que obtienes 20150215
La hora la tienes en la columna "D".
13:13
El departamento lo tienes en la columna "E"
1302
Si juntas todo eso, te da el nombre del archivo a insertar.

La imagen esta en la carpeta adentro de la carpeta de cada servidor el cual tienes en la columna B, es decir hay una carpeta que se llama Servidor1, otra Servidor2, y otra Servidor3.

Las imágenes de cada servidor se guardan en su respectiva carpeta

No entiendo por qué pones esto:

"Porque en la fila viene la fecha en la columna "A" con la que obtienes 20150215
La hora la tienes en la columna "D".
13:13
El departamento lo tienes en la columna "E"
1302
Si juntas todo eso, te da el nombre del archivo a insertar."

¿El nombre ya se guarda con esos datos o no es así?

Si, pero para que puedas insertar la imagen que se llama de la misma manera....

ubicada en la carpeta del servidor

Te anexo la macro para insertar la imagen, prueba con la imagen:

2015021513131302.bmp

Las imágenes deberán tener extensión bmp

Sub CorrespondenciaConWord()
'Por.Dante Amor
    '
    patharch = ThisWorkbook.Path & "\cartas.dotx"
    i = ActiveCell.Row
    '
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    objWord.documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
    '
    For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
        textobuscar = Cells(1, j)
        objWord.Selection.Move 6, -1
        objWord.Selection.Find.Execute FindText:=textobuscar
        '
        While objWord.Selection.Find.found = True
            objWord.Selection.Text = Cells(i, j) 'texto a reemplazar
            objWord.Selection.Move 6, -1
            objWord.Selection.Find.Execute FindText:=textobuscar
        Wend
        '
    Next
    '
    ruta = "\\2\18\"
    ruta = ThisWorkbook.Path & "\"
    archivo = ruta & Format(Cells(i, "A"), "yyyymmdd") & Format(Cells(i, "D"), "HHMM") & Cells(i, "E")
    If Dir(archivo & ".bmp") <> "" Then
        objWord.Selection.Find.Execute FindText:="Insertar imagen"
        Set objShape = objWord.Selection.InlineShapes.AddPicture(archivo & ".bmp")
    End If
    '
    ObjWord. Activate
    ObjWord. ActiveDocument. SaveAs archivo
 objWord. ActiveDocument. Close
 objWord. Quit
End Sub

Saludos.Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas