|
Responder ![]() |
Autor | |
agmolrio ![]() Nuevo ![]() Unido: 30/Enero/2005 Localización: España Estado: Sin conexión Puntos: 7 |
![]() 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. |
|
![]() |
|
Mihura ![]() Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Administrador ![]() ![]() Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 13814 |
![]() |
Antes que ponerme a trastear con word yo me plantearía modificar la imagen que inserta la plantilla, lo veo mucho más simple.
|
|
![]() |
|
agmolrio ![]() Nuevo ![]() Unido: 30/Enero/2005 Localización: España Estado: Sin conexión Puntos: 7 |
![]() |
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.
|
|
![]() |
|
prga ![]() Moderador ![]() Unido: 16/Noviembre/2004 Localización: España Estado: Sin conexión Puntos: 3510 |
![]() |
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
|
|
![]() |
|
agmolrio ![]() Nuevo ![]() Unido: 30/Enero/2005 Localización: España Estado: Sin conexión Puntos: 7 |
![]() |
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 |
|
![]() |
|
prga ![]() Moderador ![]() Unido: 16/Noviembre/2004 Localización: España Estado: Sin conexión Puntos: 3510 |
![]() |
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 |
|
![]() |
|
agmolrio ![]() Nuevo ![]() Unido: 30/Enero/2005 Localización: España Estado: Sin conexión Puntos: 7 |
![]() |
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 |
|
![]() |
Responder ![]() |
|
Tweet
|
Ir al foro | Permisos de foro ![]() Usted No puede publicar nuevos temas en este foro Usted No puede responder a temas en este foro Usted No puede borrar sus mensajes en este foro Usted No puede editar sus mensajes en este foro Usted No puede crear encuestas en este foro Usted No puede votar en encuestas en este foro |