Word - Manejo de imágenes en WORD con VBA

Manejo de imágenes en WORD con VBA

Impreso de: Foro de Access y VBA
Categoría: Otros de Microsoft: Windows y Office
Nombre del foro: Word
Descripción del foro: Foro de Word
URL: http://www.mvp-access.com/foro/forum_posts.asp?TID=86714
Fecha de impresión: 26/Marzo/2026 a las 17:33

Tema: Manejo de imágenes en WORD con VBA

Publicado por: agmolrio
Asunto: Manejo de imágenes en WORD con VBA
Fecha de publicación: 06/Junio/2023 a las 13:21

Tengo una plantilla que al crear un documento nuevo con ella me inserta automáticamente una imagen.

En un momento determinado yo quiero utilizar una macro que en función del título del documento me inserta una determinada imagen sustituyendo a la que ya existe, situándola en el mismo lugar y con las mismas características (Texto rodeando a la imagen y tamaño). Lo que manualmente se hace con "Cambiar imagen".

Soy incapaz de hacerlo ya que si digo "Grabar Macro" no actúa cuando quiero trabajar con imágenes.

Consigo insertar la imagen, pero donde le viene bien (imagino que donde se encuentre el cursor). Si no puedo sustituirla, al menos me gustaría saber como puedo moverla donde necesito y aplicarle ciertas propiedades como tamaño y que el texto rodee a la imagen. Por supuesto todo con VBA.

Muchas gracias de antemano por vuestra ayuda.

Respuestas:

Publicado por: Mihura
Fecha de publicación: 06/Junio/2023 a las 13:53

Antes que ponerme a trastear con word yo me plantearía modificar la imagen que inserta la plantilla, lo veo mucho más simple.

-------------
Jesús Mansilla Castells.
Saludos desde Móstoles.

http://www.accessaplicaciones.com" rel="nofollow - Access Aplicaciones
http://www.tecsys.es" rel="nofollow - Tecsys.es

Publicado por: agmolrio
Fecha de publicación: 06/Junio/2023 a las 14:37

La imagen de la plantilla sólo se utiliza como muestra de donde tiene que ir la otra y con que tamaño, me da igual usarla o no. Lo que necesito saber es como colocar una nueva imagen en una posición de la hoja, cambiar su tamaño y asignarla propiedades como "ajustar texto" alrededor.

Cuando yo digo en WORD, "cambiar imagen" me sustituye la imagen donde yo la quiero y le asigna el tamaño apropiado y sus características, como la de "Texto alrededor". Por eso he puesto la imagen en la plantilla y el sistema me parecía muy eficiente.

Publicado por: prga
Fecha de publicación: 08/Junio/2023 a las 11:28

Hola.

Ante la falta de respuestas más sencillas, que seguro las hay, una posible solución pasa por el siguiente ejemplo de prueba:

Public Sub CambiaImagen()

Dim Imatgenova As Shape

Dim rutaimatgeantiga As String

Dim mNom As String

Dim mLeft As Single

Dim mTop As Single

Dim mWidth As Single

Dim mHeight As Single

Dim maspecte As Long

Dim mtipo As Long

Dim imatgeantiga As Shape

Dim dlgOpen As Object

On Error Resume Next

Set imatgeantiga = ActiveDocument.Shapes("imagenplantilla") ''''ojo es el nombre de la imagen a substituir

If Err.Number <> 0 Then

MsgBox ("La imagen (shape) 'imagenplantilla' no existe")

Exit Sub

End If

On Error GoTo 0

Application.ScreenUpdating = False

Set dlgOpen = Application.FileDialog(msoFileDialogOpen)

dlgOpen.AllowMultiSelect = False

dlgOpen.Filters.Clear

dlgOpen.Filters.Add "*.*", "*.*"

If dlgOpen.Show = True Then

rutaimatgeantiga = IIf(IsNull(dlgOpen.SelectedItems(1)), "", dlgOpen.SelectedItems(1))

Else

rutaimatgeantiga = ""

End If

If rutaimatgeantiga = "" Then

MsgBox ("No fichero seleccionado")

Application.ScreenUpdating = True

Exit Sub

End If

mNom = imatgeantiga.Name

mLeft = imatgeantiga.Left

mTop = imatgeantiga.Top

mWidth = imatgeantiga.Width

mHeight = imatgeantiga.Height

mtipo = imatgeantiga.WrapFormat.Type

maspecte = imatgeantiga.LockAspectRatio

Set Imatgenova = ActiveDocument.Shapes.AddPicture(rutaimatgeantiga, msoFalse, msoCTrue) ''', mLeft, mTop, mWidth, mHeight)

DoEvents

If Imatgenova Is Nothing Then

MsgBox ("error al insertar foto")

Else 'OJO se ha insertado con las dimensiones originales de la foto, puede descuadrar documento

imatgeantiga.Delete 'Elimina la imagen antigua

Imatgenova.Name = mNom

Imatgenova.LockAspectRatio = maspecte

'''''habrá que comprobar si es mas alta o ancha en proporción con el original

Imatgenova.Left = mLeft

Imatgenova.Top = mTop

Imatgenova.Width = mWidth

Imatgenova.Height = mHeight

Imatgenova.WrapFormat.Type = mtipo

Set Imatgenova = Nothing

End If

Set imatgeantiga = Nothing

Application.ScreenUpdating = True

End Sub

en el se supone que hay una imagen a sustituir (imagenplantilla) y luego se abre un cuadro de diálogo para buscar una imagen, imagen que se inserta en el lugar de la otra.
Repito que es un ejemplo de prueba que tiene falta de mejorar, adaptar etc etc.

Espero que sirva de ayuda.

Ya comentas

Un saludo a todos

Publicado por: agmolrio
Fecha de publicación: 09/Junio/2023 a las 19:16

GENIAL. Muchas gracias Prga. Funciona muy bien, he hecho algún cambio pero prácticamente nada. He cambiado un nombre que me daba lugar a error. "rutaimatgeantiga" por "rutaimatgeNova".

Como las imágenes que tengo que insertar tienen el mismo tamaño que la de plantilla no he tenido que usar "LockAspectRatio". He intentado usarlo para probarlo pero no me ha funcionado.

Ahora el procedimiento toma automáticamente el nombre de la imagen de la plantilla para no asignárselo manualmente. Basta conque tengas un documento con una sóla imagen y ya se puede probar. Esa imagen servirá como plantilla y será sustituida por la elegida. He añadido muchos comentarios por si puede servir de ayuda a alguien.

Si quieres echarle un vistazo a ver si consigues que funcione lo de "LockAspectRatio" te lo agradecería mucho.

Adjunto el código:

Sub CambiaImagen()
'Este procedimiento parte de un documento Word que tiene una sola imagen,
'    aparte de texto y otros posibles objetos.
'El procedimiento nos solicita una imagen a partir de un cuadro de diálogo
'    que va a sustituar a la imagen original del documento.
'En mi caso las nuevas imágenes tienen las mismas dimensiones que la de plantilla
'    por lo que no necesito tener cuidado con las proporciones.
'    Para que las respete debemos utilizar ".LockAspectRatio = msoTrue" aunque a mi no me ha funcionado en pruebas
'    Esto haría que la imagen quede dentro del recuadro de la imagen pero proporcionada.

    Dim imatgeAntiga As Shape         'Imagen de la plantilla
    Dim ImatgeNova As Shape           'Nueva imagen que va a reemplazar a la antigua
    Dim rutaImatgeNova As String      'Ruta de la imagen Nueva
    Dim mNom As String                'Nombre de la imagen nueva
    Dim mLeft As Single               'Posición izquierda de la imagen nueva (Los tamaños van en puntos)
    Dim mTop As Single                'Posición superior de la imagen nueva
    Dim mWidth As Single              'Ancho de la imagen nueva
    Dim mHeight As Single             'Alto de la imagen nueva
    Dim maspecte As Long              'Aspecto (Redimensionar) de la imagen nueva
    Dim mtipo As Long                 'Ajuste de la imagen nueva
    Dim dlgOpen As Object             'Cuadro de diálogo

    'Oara saber el nombre de la imagen ·imagenplantilla·
    Dim ws As Word.Shape            'Shape auxiliar para obtener nombre imagen plantilla            '
    Dim nomImaPlantilla As String   'Nombre de la iagen que sirve de platilla

    For Each ws In ActiveDocument.Shapes 'En el ejemplo sólo hay una imagen
      If ws.Type = 13 Then                'Pregunta si Shape es una imagen
        nomImaPlantilla = ws.Name         'Toma el nombre de la imagen de la plantilla
        Exit For
      End If
    Next ws
    If nomImaPlantilla = "" Then          'No se ha encontrado ninguna imagen en el documento
      MsgBox "El documento no tiene imágenes"
    End If

    On Error Resume Next
    Set imatgeAntiga = ActiveDocument.Shapes(nomImaPlantilla) ''''ojo es el nombre de la imagen a substituir
    If Err.Number <> 0 Then
      MsgBox ("La imagen (shape) 'imagenplantilla' no existe")
      Exit Sub
    End If
    On Error GoTo 0
    Application.ScreenUpdating = False 'Desactiva la actualización de pantallas,
                                        'no se ve lo que sucede pero la macro va más rápida

    'Prepara; selección de ficheros de imagen en este caso la imagen nueva
    Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
    dlgOpen.AllowMultiSelect = False    'No se admite selecciones múltiples
    dlgOpen.Filters.Clear               'Borra los posibles filtros
    dlgOpen.Filters.Add "Imágenes", "*.jpg*"   'Sólo utiliza filtro ".jpg" ya que sólo utiliza ese tipo
    If dlgOpen.Show = True Then         'Se muestra ventana para seleccionar ficheros. Y si correcto...
                                        'Carga la ruta de la imagen seleccionada (rutaImatgeNova)
      rutaImatgeNova = IIf(IsNull(dlgOpen.SelectedItems(1)), "", dlgOpen.SelectedItems(1))
    Else
      rutaImatgeNova = ""
    End If
    If rutaImatgeNova = "" Then       'No se ha seleccionado imagen o ha habido una incidencia
      MsgBox ("No fichero seleccionado")
      Application.ScreenUpdating = True 'Vuelve a activar la actualización de pantallas
      Exit Sub
    End If

    'Toma propiedades de la imagen de la plantilla
    mNom = imatgeAntiga.Name                'Nombre de la imagen antigua
    mLeft = imatgeAntiga.Left               'Posición izquierda
    mTop = imatgeAntiga.Top                 'Posición superior
    mWidth = imatgeAntiga.Width             'Ancho de la imagen (Los tamaños van en puntos)
    mHeight = imatgeAntiga.Height           'Alto de la imagen
    mtipo = imatgeAntiga.WrapFormat.Type    'Ajuste de la forma
    'Mostrar imagen nueva, la que sustituye a la de la plantilla
    'Le da las mismas propiedades que la original ya que la nueva imagen tiene las mismas propiedades que la antigua.
    'Shapes.AddPicture (rutaImagen, ImagenEnlazada, salvarConDocumento, [Izq}, [Arriba], [Ancho], [Alto]) [Propiedades opcionales]
    '       El aspecto (LockAspectRatio) de be utlizarse al mostrar la imagen (en Shapes.AddPicture)
    Set ImatgeNova = ActiveDocument.Shapes.AddPicture _
            (rutaImatgeNova, msoFalse, msoCTrue, mLeft, mTop, mWidth, mHeight)
    ImatgeNova.LockAspectRatio = msoTrue 'NO PARECE QUE FUNCIONE
    DoEvents
    If ImatgeNova Is Nothing Then
        MsgBox ("error al insertar foto")
    Else   'OJO se ha insertado con las dimensiones originales de la foto, puede descuadrar documento
        imatgeAntiga.Delete 'Elimina la imagen antigua, la de plantilla
        ImatgeNova.Name = mNom 'Cambia el nombre a la nueva imagen, dándole el de la antigua
        ImatgeNova.WrapFormat.Type = mtipo
        'No se asignan estas propiedades ya que se hizo al cargar la imagen
'        ImatgeNova.Left = mLeft
'        ImatgeNova.Top = mTop
'        ImatgeNova.Width = mWidth
'        ImatgeNova.Height = mHeight
        Set ImatgeNova = Nothing

        End If
    Set imatgeAntiga = Nothing
    Application.ScreenUpdating = True
End Sub

Publicado por: prga
Fecha de publicación: 09/Junio/2023 a las 19:40

hola.

Me alegro que haya servido como idea, estas cosas siempre se tienen que ajustar a la necesidad de cada uno.
Una cosa, si la plantilla sólo tiene una imagen (la que se tiene que sustituir), es mas sencillo localizarla como:

Set imatgeAntiga = ActiveDocument.Shapes(1) y nos ahorramos todo el código de búsqueda del nombre de la imagen a sustituir ( en el caso que haya varias).

lo del Lockaspectratio, salvo mejor opinión sirve para mantener la proporción entre las dimensiones de la foto, vamos con ese condicionante, si damos la altura, ajusta automáticamente la anchura o al revés, si damos la anchura ajusta la altura sin "deformar" la imagen

Ya comentas y si te sirve nos dices que cerremos el hilo

Un saludo a todos

Publicado por: agmolrio
Fecha de publicación: 09/Junio/2023 a las 19:48

De nuevo, gracias. Lo de la búsqueda de la imagen lo he puesto por motivos didácticos por si alguien quiere usarla. Así no tiene que saber el nombre Pero tienes razón si se le dice que es la primera imagen ya actúa sobre ella. En cuanto al "LockAspectRadio" seguiré probando aunque no lo necesite.

Por mi se puede cerrar el tema.

Cuando sea mayor (cosa que no creo que pueda ser mucho más) me gustaría saber tanto como tú.

PD. En mi caso no serviría ya que tengo un cuadro de texto y me lo toma también como Shape y no se si va antes o después. Pero no me preocuparía pues ya le asigné nombre al generar la plantilla.