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