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
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 SubMi 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 SubSaludos.Dante Amor
