none
Macro to search for Graphic, Resize to X% RRS feed

  • Question

  • In Word 2010, I would like to search for a graphic, select the graphic, resize the graphic proportionately to 75%. 

    Used to be able to record such a macro, but no more!  

    Thanks in advance. 

    Thursday, October 3, 2013 4:15 PM

Answers

  • The question, of course, is 75% of what - their full size or their current display size? Note that, if the images have been compressed and not edited since, their full size is their current display size.

    Here's some code that processes all objects (inline and floating) in all StoryRanges to get you started. Extra logic would be required to limit the code's operations to particular types of object and/or to exclude particular story ranges.

    Sub ReformatAllObjects()
    Application.ScreenUpdating = False
    Dim oShp As Shape, iShp As InlineShape, Hght As Single, Rng As Range
    With ActiveDocument
      For Each Rng In .StoryRanges
        For Each oShp In Rng.ShapeRange
          With oShp
            .LockAspectRatio = True
            .ScaleHeight 0.75, False 'True to scale relative to original size
          End With
        Next oShp
        For Each iShp In Rng.InlineShapes
          With iShp
            .LockAspectRatio = True
            Hght = .ScaleHeight
            .ScaleHeight = 0.75 * Hght 'Delete "* Hght" to scale per original size
          End With
        Next iShp
      Next Rng
    End With
    Application.ScreenUpdating = True
    MsgBox "Finished Reformatting."
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Friday, October 4, 2013 7:26 AM

All replies

  • I've got an app for that. http://www.greatcirclelearning.com/productivity-automation-tools-for-Microsoft%20Office

    Kind Regards, Rich ... http://greatcirclelearning.com

    Thursday, October 3, 2013 10:55 PM
  • The question, of course, is 75% of what - their full size or their current display size? Note that, if the images have been compressed and not edited since, their full size is their current display size.

    Here's some code that processes all objects (inline and floating) in all StoryRanges to get you started. Extra logic would be required to limit the code's operations to particular types of object and/or to exclude particular story ranges.

    Sub ReformatAllObjects()
    Application.ScreenUpdating = False
    Dim oShp As Shape, iShp As InlineShape, Hght As Single, Rng As Range
    With ActiveDocument
      For Each Rng In .StoryRanges
        For Each oShp In Rng.ShapeRange
          With oShp
            .LockAspectRatio = True
            .ScaleHeight 0.75, False 'True to scale relative to original size
          End With
        Next oShp
        For Each iShp In Rng.InlineShapes
          With iShp
            .LockAspectRatio = True
            Hght = .ScaleHeight
            .ScaleHeight = 0.75 * Hght 'Delete "* Hght" to scale per original size
          End With
        Next iShp
      Next Rng
    End With
    Application.ScreenUpdating = True
    MsgBox "Finished Reformatting."
    End Sub


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Friday, October 4, 2013 7:26 AM