Buscar la forma de seleccionar la imagen de manera automática.
Para "Dante Amor"
¿Habrá alguna otra alternativa que me permita que en lugar de seleccionar la imagen, opte la macro por extraer la imagen a partir del contenido de la celda de excel, siendo este valor solo el nombre de la imagen o bien el texto con la dirección de la carpeta donde se ubica la misma imagen?
Esta es mi macro:
Sub toWord()
Application.ScreenUpdating = False
wArch = Hoja8.Range("C3").Text & Hoja8.Range("C2").Text & ".dotx" 'Ubicacion y nombre de la plantilla:
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.documents.Add Template:=wArch, NewTemplate:=False, DocumentType:=0
Selection.Copy
For i = 1 To Hoja8.Range("C1").Value 'Celda donde esta la cuenta
datos = Hoja8.Range("B" & i).Text 'Donde estan los datos
reemp = Hoja8.Range("A" & i).Text 'Donde estan las etiquetas
With objWord.Selection.Find 'buscar y reemplazar de word
.Text = datos 'Busca el texto de datos
.Replacement.Text = reemp 'Reemplaza por el texto
.Execute Replace:=2 'La variable dos es para reemplazar todos los valores
End With
Next i
objWord.Activate
For j = 1 To Hoja8.Range("C4").Value 'Celda con el valor para ejecutar el ciclo de la imagen
objWord.Selection.PasteAndFormat Type:=wdFormatOriginalFormatting
Next j
Application.ScreenUpdating = True
End Sub
1 respuesta
¡Gracias! la envío en breve.
Te anexo la macro
Sub toWord()
'Act.Por.Dante Amor
Application.ScreenUpdating = False
wArch = Hoja8.Range("C3").Text & Hoja8.Range("C2").Text & ".dotx" 'Ubicacion y nombre de la plantilla:
'wArch = ThisWorkbook.Path & "\" & Hoja8.Range("C2").Text & ".dotx" 'Ubicacion y nombre de la plantilla:
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.documents.Add Template:=wArch, NewTemplate:=False, DocumentType:=0
'
For i = 1 To Hoja8.Range("C1").Value 'Celda donde esta la cuenta
datos = Hoja8.Range("B" & i).Text 'Donde estan los datos
reemp = Hoja8.Range("A" & i).Text 'Donde estan las etiquetas
With objWord.Selection.Find 'buscar y reemplazar de word
.Text = datos 'Busca el texto de datos
.Replacement.Text = reemp 'Reemplaza por el texto
.Execute Replace:=2 'La variable dos es para reemplazar todos los valores
End With
Next i
'
Set h = Sheets("CAPTURA")
h.Select
alt1 = h.Cells(h.Range("D1") + 2, "A").Top 'alto de la fila a transferir
alt2 = h.Cells(h.Range("D1") + 3, "A").Top 'alto siguientefila
izq1 = h.Range("V1").Left 'izquierda columna V
izq2 = h.Range("W1").Left 'izquierda siguientecolumna
'
For Each img In h.DrawingObjects
If img.Top >= alt1 And img.Top <= alt2 And _
img.Left >= izq1 And img.Left <= izq2 Then
img.Select
Selection.Copy
objWord.Activate
datos = Hoja8.Range("A5")
objWord.Selection.Find.Execute FindText:=datos
objWord.Selection.PasteAndFormat Type:=wdFormatOriginalFormatting
Exit For
End If
Next
Application.ScreenUpdating = True
MsgBox "fin"
End Subsal u dos
¡Gracias! Funciona muy bien Dante, agradezco el aporte, me queda duda respecto a la extracción de la imagen, podría ser posible una alternativa que en lugar de seleccionar la imagen de la base de datos, se extraiga utilizando la dirección origen de la imagen, la cual se encuentra capturada en una columna de base de datos? por ejemplo: (C:\Users\USUARIO\Desktop\IMAGENES\inicio.jpg)
Lo que hace el código es copiar y pegar.
Si quieres importar la imagen desde un archivo y ponerla en word eso sería otro código que no conozco, tendrías que investigarlo.
