** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Word
  Mensajes nuevos Mensajes nuevos RSS - Obtener imágenes de un rango de Excel en Word
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Obtener imágenes de un rango de Excel en Word

 Responder Responder
Autor
Mensaje
eyner133 Ver desplegable
Nuevo
Nuevo


Unido: 02/Septiembre/2022
Localización: Perú
Estado: Sin conexión
Puntos: 1
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita eyner133 Cita  ResponderRespuesta Enlace directo a este mensaje Tema: Obtener imágenes de un rango de Excel en Word
    Enviado: 02/Septiembre/2022 a las 18:09
Buenos días.

Quisiera que me pudieran orientar como hacer lo siguiente:
Tengo una una plantilla de word, en la cual estoy ejecutando una macro para obtener contenido de archivos excel, lo que quisiera saber es como puedo obtener las imágenes de excel, desde una macro en word.

Gracias.
Arriba
prga Ver desplegable
Moderador
Moderador


Unido: 16/Noviembre/2004
Localización: España
Estado: Sin conexión
Puntos: 3523
Opciones de entrada Opciones de entrada   Gracias (0) Gracias(0)   Cita prga Cita  ResponderRespuesta Enlace directo a este mensaje Enviado: 07/Septiembre/2022 a las 12:35
Hola.
Sí he entendido bien, este código de word recorre un rango de celdas(rango1) de Excel y pega las imágenes encontradas en ese rango de celdas del excel en una tabla de word con suficientes filas para pegar las imágenes en la primera columna

Public Sub copiaImgRangoExcel()
Dim miexcel As Object ''''Excel.Application
Dim PrimeraFila As Integer
Dim PrimeraColumna As Integer
Dim UltimaFila As Integer
Dim UltimaColumna As Integer
Dim miimagen As Object
Dim tc As Long
Dim tr As Long
Dim nn As Long
Dim mirango As Object '''Excel.Range
Set miexcel = CreateObject("excel.application")
miexcel.Workbooks.Add ActiveDocument.Path & "\excelconrangoimagenes.xlsx"
miexcel.Visible = True

Set mirango = miexcel.Range("rango1")
PrimeraFila = mirango.Cells(1, 1).Row
PrimeraColumna = mirango.Cells(1, 1).Column
UltimaFila = mirango.Cells(mirango.Cells.Rows.Count, 1).Row
UltimaColumna = mirango.Cells(1, mirango.Cells.Columns.Count).Column
On Error Resume Next
For Each miimagen In miexcel.ActiveSheet.Shapes
    tc = miimagen.BottomRightCell.Column
    tr = miimagen.BottomRightCell.Row
    If (tc >= PrimeraColumna And tc <= UltimaColumna) And (tr >= PrimeraFila And tr <= UltimaFila) Then
         If miimagen.Type = 13 Then
             miimagen.Copy
             DoEvents
             '''''''''''''''''pega en word
           nn = nn + 1
           ActiveDocument.Tables(1).Cell(nn, 1).Select
           Selection.PasteAndFormat (wdPasteDefault)
           DoEvents
           '''''''''''''''''''fin pega en word
         End If
    End If

Next
  On Error GoTo 0

miexcel.Quit
Set miexcel = Nothing

End Sub


Este código es a título de ejemplo y habrá que ajustarlo a las necesidades propias etc etc.
Seguro que hay soluciones más sencillas, pero al menos espero que ayude a resolver la duda
Ya comentas
Un saludo a todos
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable