none
Office 2016 - Word | Cambiar tamaño de imágenes realizadas en posición horizontal y Vertical con una Macro en Word

    Pregunta

  • Me gustaría unir las dos Macros abajo mostradas, porque tengo el problema que hay fotos realizadas en posición vertical y horizontal, entonces no me las pone todas del mismo tamaño, si las separo en los dos tipos y aplico cada macro por separado sí, pero me gustaría poder unir ambas, pero no lo consigo. ME queda cada una de un tamaño distinto.

    Sub RedimensionarHORIZONTAL()
    ' Cambia el ancho de todas las imágenes del documento (para fotos Horizontales cambia el ancho)
    ' al siguiente valor en cm (la altura se determina sola):
    'Ancho = 7.5
    'Ancho = CentimetersToPoints(Ancho)
    Alto = 7.5
    Alto = CentimetersToPoints(Alto)

    For Each Flotante In ActiveDocument.Shapes
    '    Flotante.Height = Ancho * Flotante.Height / Flotante.Width
    '    Flotante.Width = Ancho
        Flotante.Width = Alto * Flotante.Width / Flotante.Height
        Flotante.Height = Alto
    Next
    For Each EnLinea In ActiveDocument.InlineShapes
    '    EnLinea.Height = Ancho * EnLinea.Height / EnLinea.Width
    '    EnLinea.Width = Ancho
    '    * EnLinea.Width / EnLinea.Height
        EnLinea.Height = Alto
        EnLinea.Width = Alto * EnLinea.Width / EnLinea.Height
    Next
    End Sub

    Sub DimensionarfotoVERTICAL()
    '
    ' DimensionarfotoVERTICAL Macro
    '
    Ancho = 7.5
    Ancho = CentimetersToPoints(Ancho)
    ' Alto = 7.5
    ' Alto = CentimetersToPoints(Alto)

    For Each Flotante In ActiveDocument.Shapes
        Flotante.Height = Ancho * Flotante.Height / Flotante.Width
        Flotante.Width = Ancho
    '    Flotante.Width = Alto * Flotante.Width / Flotante.Height
    '    Flotante.Height = Alto
    Next
    For Each EnLinea In ActiveDocument.InlineShapes
        EnLinea.Height = Ancho * EnLinea.Height / EnLinea.Width
        EnLinea.Width = Ancho

    '   EnLinea.Height = Alto
    '   EnLinea.Width = Alto * EnLinea.Width / EnLinea.Height
    Next
        
    End Sub

    Muchas gracias

    jueves, 16 de noviembre de 2017 7:58