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

Tema cerradoManejo de imágenes en WORD con VBA

 Responder Responder
Autor
Mensaje
agmolrio Ver desplegable
Nuevo
Nuevo


Unido: 30/Enero/2005
Localización: España
Estado: Sin conexión
Puntos: 7
Enlace directo a este mensaje Tema: Manejo de imágenes en WORD con VBA
    Enviado: 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.
Arriba
Mihura Ver desplegable
Administrador
Administrador
Avatar

Unido: 06/Mayo/2005
Localización: En la dehesa
Estado: Sin conexión
Puntos: 14017
Enlace directo a este mensaje Enviado: 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.

Access Aplicaciones
Tecsys.es
Arriba
agmolrio Ver desplegable
Nuevo
Nuevo


Unido: 30/Enero/2005
Localización: España
Estado: Sin conexión
Puntos: 7
Enlace directo a este mensaje Enviado: 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.
Arriba
prga Ver desplegable
Moderador
Moderador


Unido: 16/Noviembre/2004
Localización: España
Estado: Sin conexión
Puntos: 3523
Enlace directo a este mensaje Enviado: 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
Arriba
agmolrio Ver desplegable
Nuevo
Nuevo


Unido: 30/Enero/2005
Localización: España
Estado: Sin conexión
Puntos: 7
Enlace directo a este mensaje Enviado: 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

Arriba
prga Ver desplegable
Moderador
Moderador


Unido: 16/Noviembre/2004
Localización: España
Estado: Sin conexión
Puntos: 3523
Enlace directo a este mensaje Enviado: 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

Arriba
agmolrio Ver desplegable
Nuevo
Nuevo


Unido: 30/Enero/2005
Localización: España
Estado: Sin conexión
Puntos: 7
Enlace directo a este mensaje Enviado: 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.


Editado por agmolrio - 09/Junio/2023 a las 19:53
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable