lunes, 13 de abril de 2015

VBA: Pasar imagen de Excel a Word.

Hoy veremos un sencillo código para traspasar, mediante macros, una imagen desde nuestra hoja de cálculo a un documento de Word (insertado en una Tabla).
De especial en este ejemplo, es que generamos una Tabla en nuestro documento de Word, en la cual insertamos la imagen.
Además verificaremos si existe el fichero .docx o no, tomando el nombre del fichero de la celda G1.


Tenemos la siguiente imagen superpuesta en un rango de celdas... la idea es seleccionar el rango y copiarlo como imagen, para luego copiar y pegarlo en un documento de Word.

VBA: Pasar imagen de Excel a Word.



Insertamos el código asociado al control CommandButton y ejecutamos el siguiente procedimiento:

Private Sub CommandButton1_Click()
'con la referencia Microsoft Word 15.0 Object Library
Dim tabla As Object
'copiamos el rango de la hoja de cálculo
Sheets("ExcelToWord").Select
Range("B1:E11").CopyPicture xlScreen, xlPicture

'definimos la ruta destino del documento de Word
'tomando como nombre de docx el valor de la celda G1
Dim archivo As String
archivo = "E:\excelforo\" & Range("G1") & ".docx"
'Creamos el documento
Set objWord = CreateObject("Word.Application")
'y lo hacemos visible
objWord.Visible = True

'verificamos si existe o no un .docx con ese nombre (celda G1)
With objWord
    If Dir(archivo) = "" Then
        'si no existe lo añadimos nuevo
        Set objDoc = objWord.Documents.Add
        objDoc.SaveAs (archivo)
     Else
        'si existe lo abrimos
        Set objDoc = .Documents.Open(archivo)
    End If
End With
'generamos una Tabla en el documento de Word
Set tabla = objDoc.Tables.Add(objDoc.Range, 1, 1)
'y pegamos en la celda 'A1' de la tabla de Word la imagen
tabla.cell(1, 1).Range.Paste
'acabamos guardando el Word
objDoc.Save
     
Set tabla = Nothing
End Sub



Tras ejecutar el proceso veremos nuestro documento Word:

VBA: Pasar imagen de Excel a Word.



NOTA: es importante activar/habilitar la referencia 'Microsoft Word 15.0 Object Library'

6 comentarios:

  1. Excelente aporte. Mil gracias.

    ResponderEliminar
  2. y en el caso en el que se esté trabajando en Word, y de Woed se quiera obtener la imagen de Excel, y mostrarla en Word, cómo se haría?
    Muchas Gracias de Antemano.

    ResponderEliminar
    Respuestas
    1. Hola Miguel,
      debe ser algo similar... por desgracias no soy exporto en VBA para Word y no puedo ayudarte demasiado.
      Emplea el asistente de grabación de macros en Word.. quizá obtengas algo de código que te ayudará.
      Puedes buscar en foros especializados en Word.

      Suerte!!

      Eliminar
  3. quisiera poner más tablas pero no sé como separarlas, intenté esto pero me deja la última tabla


    set tabla2 = objDoc.Tables.Add(objDoc.Range, 1, 1)

    tabla2.cell(1, 1).Range.Paste

    ResponderEliminar
  4. tengo un problema, quiero pasar tablas de varias hojas a una plantilla de word, y no logro hacerlo, tengo este codigo para pasar de algunas celdas a word.

    Private Sub CommandButton1_Click()
    Dim datos(0 To 1, 0 To 20) As String ' (columna,fila)
    patharch = ThisWorkbook.Path & "\MUESTRA.dotm"
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    objWord.documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0

    datos(0, 0) = "[A1]"
    datos(1, 0) = Hoja2.Cells(5, 2) '(fila,columna)
    datos(0, 1) = "[A2]"
    datos(1, 1) = Hoja2.Cells(6, 2)
    datos(0, 2) = "[A3]"
    datos(1, 2) = Hoja2.Cells(7, 2)
    datos(0, 3) = "[B1]"
    datos(1, 3) = Hoja3.Cells(4, 2)
    datos(0, 4) = "[B2]"
    datos(1, 4) = Hoja3.Cells(5, 2)
    datos(0, 5) = "[B3]"
    datos(1, 5) = Hoja3.Cells(6, 2) '(fila,columna)


    For I = 0 To UBound(datos, 2)
    textobuscar = datos(0, I)
    objWord.Selection.Move 6, -1
    objWord.Selection.Find.Execute FindText:=textobuscar

    While objWord.Selection.Find.found = True
    objWord.Selection.Text = datos(1, I) 'texto a reemplazar
    objWord.Selection.Move 6, -1
    objWord.Selection.Find.Execute FindText:=textobuscar
    Wend

    Next I

    objWord.Activate
    End Sub

    ResponderEliminar
    Respuestas
    1. Hola Amilcar,
      por favor, lee las Normas de uso del blog, y si procede envíame un email donde se indica

      Saludos

      Eliminar

Nota: solo los miembros de este blog pueden publicar comentarios.