es.davy.ai

Preguntas y respuestas de programación confiables

¿Tienes una pregunta?

Si tienes alguna pregunta, puedes hacerla a continuación o ingresar lo que estás buscando.

Macro de Word VBA: Ajustar la imagen a la forma

17 Jul, 2023 Programación

Me gustaría ajustar la imagen a la forma. El código es simple:

Function CmPt(cm As Single) As Single
' Convertir centímetros a puntos.

CmPt = Application.CentimetersToPoints(cm)

End Function

Sub InsertCanvas()
' Insertar lienzo de imagen de rompecabezas en el documento.

Dim edge As Single
edge = CmPt(4)

Dim canvas As Shape
Set canvas = ActiveDocument.Shapes.AddShape(Type:=msoShapeRectangle, Left:=CmPt(2.5), Top:=CmPt(2.5), Width:=edge, Height:=edge, Anchor:=Selection.Paragraphs(1).Range)

Dim image_path As String
image_path = ActiveDocument.Path & Application.PathSeparator & "images" & Application.PathSeparator & "image.jpeg"

With canvas
    .Line.Weight = 1
    .Line.ForeColor.RGB = RGB(64, 64, 64)

    .Fill.Visible = msoTrue
    .Fill.BackColor.RGB = RGB(255, 255, 255)
    .Fill.UserPicture image_path
End With
End Sub

Pero ahora, la imagen está llenando el cuadro. Me gustaría ajustar la imagen. Sé que Word puede hacerlo, pero creo que tengo que calcularlo desde la relación de aspecto original. ¿Es posible obtener el tamaño original de la .UserPicture? ¿O es posible obtener el ancho y alto de cualquier imagen en el disco duro sin insertar la imagen en el documento? Gracias

Tags:  ,

Answer

  1. Avatar for davy.ai
    davy.ai

    Para ajustar la imagen a la forma, es necesario calcular la relación de aspecto de la imagen original y ajustar el tamaño del lienzo en consecuencia. Aquí hay un código actualizado que debería funcionar:

    Function CmPt(cm As Single) As Single
    ' Convertir centímetros a puntos.
    CmPt = Application.CentimetersToPoints(cm)
End Function

Sub InsertarLienzo()
    ' Insertar lienzo de imagen de rompecabezas en el documento.
    Dim borde As Single
    borde = CmPt(4)

    Dim lienzo As Shape
    Set lienzo = ActiveDocument.Shapes.AddShape(Type:=msoShapeRectangle, Left:=CmPt(2.5), Top:=CmPt(2.5), Width:=borde, Height:=borde, Anchor:=Selection.Paragraphs(1).Range)

    Dim ruta_imagen As String
    ruta_imagen = ActiveDocument.Path & Application.PathSeparator & "images" & Application.PathSeparator & "image.jpeg"

    Dim img As Object
    Set img = CreateObject("WIA.ImageFile")
    img.LoadFile ruta_imagen

    ' Calcular relación de aspecto original
    Dim relacion_aspecto As Single
    relacion_aspecto = img.Width / img.Height

    ' Calcular tamaño del lienzo
    Dim ancho_lienzo As Single, altura_lienzo As Single
    If relacion_aspecto >= 1 Then ' Orientación horizontal (landscape)
        ancho_lienzo = borde
        altura_lienzo = borde / relacion_aspecto
    Else ' Orientación vertical (portrait)
        ancho_lienzo = borde * relacion_aspecto
        altura_lienzo = borde
    End If

    ' Cambiar tamaño del lienzo para ajustarse a la imagen
    lienzo.LockAspectRatio = msoFalse
    lienzo.Width = ancho_lienzo
    lienzo.Height = altura_lienzo
    lienzo.LockAspectRatio = msoTrue

    With lienzo
        .Line.Weight = 1
        .Line.ForeColor.RGB = RGB(64, 64, 64)

        .Fill.Visible = msoTrue
        .Fill.BackColor.RGB = RGB(255, 255, 255)
        .Fill.UserPicture ruta_imagen
    End With
End Sub

    El código utiliza el Componente de Imagen de Windows (WIC) para cargar el archivo de imagen y calcular su ancho y altura originales. Luego calcula la relación de aspecto y ajusta el tamaño del lienzo en consecuencia. Finalmente, cambia el tamaño del lienzo para ajustarse a la imagen y bloquea la relación de aspecto.

    Ten en cuenta que debes agregar una referencia al “Componente de Imagen de Windows” en el Editor de VBA (Herramientas > Referencias > Microsoft Windows Imaging Component).

Comments are closed.