none
Help with Word Macro - Pictures/Borders RRS feed

  • Question

  • I work in Word 2010 and I work with large documents that take a lot of time to format (1-3 hours).

    I recently found out about Macro's and was wondering if someone could help me with some of the coding.

    The documents that I work with contain logos, pictures, and maps. The problem is, whenever I insert new photos, they are way too large and I often have to resize 5-10 photos to 3.75x5 from their original size. Also, I have to individually add a border for each one!

    Can anyone help me out in writing a macro that resizes images to 3.75 x 5 as well as add a Simple Line Style Black Border of 2 Pts?

    Also, as I am new to Macro's, is there a way to set it so that it only works between pages X to X?

    Thanks in advance!
    Thursday, November 15, 2012 3:58 PM

Answers

  • I'm not sure I follow you ultimate objective.  Try:
    Sub ResizePics()
         Dim shp As Word.Shape
         Dim iShp As Word.InlineShape
         Dim rng As Word.Range

        Set rng = Word.ActiveDocument.Bookmarks("\page").Range
         For Each iShp In rng.InlineShapes
             iShp.LockAspectRatio = False
             iShp.Height = Word.InchesToPoints(3.75)
             iShp.Width = Word.InchesToPoints(5)
             AddRoundedDiagonalCorner , iShp
         Next iShp

        For Each shp In rng.ShapeRange
             shp.LockAspectRatio = False
             shp.Height = Word.InchesToPoints(3.75)
             shp.Width = Word.InchesToPoints(5)
             AddRoundedDiagonalCorner shp
         Next shp
     End Sub
     Public Sub AddRoundedDiagonalCorner(Optional ByRef oShpPassed As Shape, Optional ByRef oILSPassed As InlineShape)
         Dim WdShape As Shape
         'Convert to shape.  I could be wrong, but this seems to be the only way to get the rounded corners.
         Set WdShape = oILSPassed.ConvertToShape
         'Round diagonal corners
         WdShape.AutoShapeType = msoShapeRound2DiagRectangle
         With WdShape.Line
             .Weight = 2
             .Style = msoLineSingle
             .ForeColor.RGB = 0
         End With
         WdShape.ConvertToInlineShape
     End Sub

     

    Please visit my website:

    http://gregmaxey.mvps.org/word_tips.html   

    Greg Maxey Please visit my website at: http://gregmaxey.mvps.org/word_tips.htm

    • Marked as answer by GordonCHC Friday, November 16, 2012 8:32 PM
    Friday, November 16, 2012 7:17 PM

All replies

  • Hi Gordon

    Some follow-up questions that anyone who helps you (I can't right now as it's the end of my day):

    1. Do these pictures have "text flow" formatting, or are they in-line with the text?

    2. It's not clear what you mean by 3.75 x 5. Is this in inches? And it doesn't matter if this may not retain original height/width relationship (aspect raitio)?


    Cindy Meister, VSTO/Word MVP, my blog

    Thursday, November 15, 2012 5:14 PM
    Moderator
  • Hi Cindy,

    Thanks for your reply.

    1. The documents are generated by one of our programs so the photos are not going to be text-flow formatting as they aren't in contact with text.

    2. Yes, its 3.75" x 5". Our pictures are larger so we just want to shrink them to make sure that they fit on the page.

    Some more info:

    We have images (logos) and we have pictures (photos). This is the reason why I was wondering if it's possible to isolate the macro to specific pages since our photos are usually imported later in the document. I have tried a couple macro codes but what seems to work on a 1-2 page document, won't work for larger documents. Our documents are around 70-100 pages and this would definitely help our formatting procedures!

    If you need more info feel free to ask!
    Thanks!

    Thursday, November 15, 2012 5:24 PM
  • My current code is this:

    Sub ResizePics()
        Dim shp As Word.Shape
        Dim iShp As Word.InlineShape
        Dim rng As Word.Range

        Set rng = Word.ActiveDocument.Bookmarks("\page").Range
        For Each iShp In rng.InlineShapes
            iShp.LockAspectRatio = False
            iShp.Height = Word.InchesToPoints(3.75)
            iShp.Width = Word.InchesToPoints(5)
        Next iShp

        For Each shp In rng.ShapeRange
            shp.LockAspectRatio = False
            shp.Height = Word.InchesToPoints(3.75)
            shp.Width = Word.InchesToPoints(5)
        Next shp
    End Sub

    Sub Demo()
        Dim iShp As InlineShape
        With ActiveDocument
            For Each iShp In .InlineShapes
                If iShp.Range.Information(wdWithInTable) = True Then
                    With iShp
                        .LockAspectRatio = True
                        .Width = .Range.Cells(1).Column.Width - 50 'You might have to tinker with the width a bit.
                    End With
                    AddRoundedDiagonalCornerWhite iShp
                End If
            Next
        End With
    End Sub
    Public Sub AddRoundedDiagonalCornerWhite(ByRef oILSPassed As InlineShape)
        Dim WdShape As Shape
         'Convert to shape.  I could be wrong, but this seems to be the only way to get the rounded corners.
        Set WdShape = oILSPassed.ConvertToShape
        WdShape.PictureFormat.ColorType = msoPictureAutomatic
         'Rounded the corners
        WdShape.AutoShapeType = msoShapeRound2DiagRectangle
         'Set other attributes to match preformatted picture.
        WdShape.Fill.Solid
        With WdShape.Line
            .Weight = 1
            .Style = msoLineSingle
            .ForeColor.RGB = 0
        End With
        With WdShape.Shadow
            .Style = msoShadowStyleOuterShadow
            .Blur = 0
            .Transparency = 0
            .Size = 0
        End With
        With WdShape.ThreeD
            .BevelBottomType = msoBevelNone
            .BevelBottomDepth = 0
            .BevelBottomInset = 0
            .BevelTopType = msoBevelCircle
            .BevelTopDepth = 0
            .BevelTopInset = 0
            .FieldOfView = 0
            .Perspective = msoFalse
            .PresetMaterial = msoMaterialWarmMatte
            .PresetLighting = msoLightRigTwoPoint
            .LightAngle = 0
        End With
        WdShape.ConvertToInlineShape
    End Sub




    What I like about this is that it does not resize ALL my images. Which is what I would like. So my resizing question has been answered.

    The main problem I have now is changing the borders for all my photos. Right now, the coding has it changing all the photos in tables. But, I would like to have my other images outside of the doc to be able to change borders as well.

    Could someone assist me please?

    Thanks

    (I have the resizing macro keyboarded shortcut, I will probably shortcut changing the borders in tables to another keyboard shortcut, so hopefully someone can help me tweak the code!)
    Thursday, November 15, 2012 11:31 PM
  • HI Gordon

    This part of your code is what's setting the border, I believe:

        With WdShape.Line
            .Weight = 1
            .Style = msoLineSingle
            .ForeColor.RGB = 0
        End With

    You should be able to use it with a bit of tweaking in your first macro for the second part (Shapes).

    For the InlineShapes: iShp.Line.Weight = 1


    Cindy Meister, VSTO/Word MVP, my blog

    Friday, November 16, 2012 9:18 AM
    Moderator
  • Your code looks oddly familiar and it does not do what you said you wanted to do in the original post (i.e., add a simple 2 pt black border):

    Sub ResizePics()
    Dim shp As Word.Shape
    Dim iShp As Word.InlineShape
    Dim rng As Word.Range
     
      Set rng = Word.ActiveDocument.Bookmarks("\page").Range
      For Each iShp In rng.InlineShapes
        iShp.LockAspectRatio = False
        iShp.Height = Word.InchesToPoints(3.75)
        iShp.Width = Word.InchesToPoints(5)
        AddBorder , iShp
      Next iShp
      For Each shp In rng.ShapeRange
        shp.LockAspectRatio = False
        shp.Height = Word.InchesToPoints(3.75)
        shp.Width = Word.InchesToPoints(5)
        AddBorder shp
      Next shp
    lbl_Exit:
      Exit Sub
    End Sub
    Public Sub AddBorder(Optional ByRef oShpPassed As Shape, Optional oILSPassed As InlineShape)
    Dim WdShape As Shape
     
      If Not oILSPassed Is Nothing Then: Set WdShape = oILSPassed.ConvertToShape
      If Not oShpPassed Is Nothing Then: Set WdShape = oShpPassed
      With WdShape.Line
        .Weight = 2
        .Style = msoLineSingle
        .ForeColor.RGB = 0
      End With
      If Not oILSPassed Is Nothing Then: WdShape.ConvertToInlineShape
    lbl_Exit:
      Exit Sub
    End Sub

    Greg Maxey Please visit my website at: http://gregmaxey.mvps.org/word_tips.htm

    Friday, November 16, 2012 1:25 PM
  • It's oddly similar because I got it from one of your posts on another website! I thank you for that too!

    We actually came to a consensus that we like the rounded edges border that was in the code that I posted! But the code you just posted is exactly what we were looking for so, how would I need to change it from the 2 pt border to the rounded edges one? I am assuming it is not a simple copy and paste over in code?

    aka. How to make the following code work for images outside of cells as well. Preferably a page macro instead of a full document macro.

    Sub ResizePics()
        Dim shp As Word.Shape
        Dim iShp As Word.InlineShape
        Dim rng As Word.Range

        Set rng = Word.ActiveDocument.Bookmarks("\page").Range
        For Each iShp In rng.InlineShapes
            iShp.LockAspectRatio = False
            iShp.Height = Word.InchesToPoints(3.75)
            iShp.Width = Word.InchesToPoints(5)
        Next iShp

        For Each shp In rng.ShapeRange
            shp.LockAspectRatio = False
            shp.Height = Word.InchesToPoints(3.75)
            shp.Width = Word.InchesToPoints(5)
        Next shp
    End Sub

    Sub Demo()
        Dim iShp As InlineShape
        With ActiveDocument
            For Each iShp In .InlineShapes
                If iShp.Range.Information(wdWithInTable) = True Then
                    With iShp
                        .LockAspectRatio = True
                        .Width = .Range.Cells(1).Column.Width - 50 'You might have to tinker with the width a bit.
                    End With
                    AddRoundedDiagonalCornerWhite iShp
                End If
            Next
        End With
    End Sub
    Public Sub AddRoundedDiagonalCornerWhite(ByRef oILSPassed As InlineShape)
        Dim WdShape As Shape
         'Convert to shape.  I could be wrong, but this seems to be the only way to get the rounded corners.
        Set WdShape = oILSPassed.ConvertToShape
        WdShape.PictureFormat.ColorType = msoPictureAutomatic
         'Rounded the corners
        WdShape.AutoShapeType = msoShapeRound2DiagRectangle
         'Set other attributes to match preformatted picture.
        WdShape.Fill.Solid
        With WdShape.Line
            .Weight = 1
            .Style = msoLineSingle
            .ForeColor.RGB = 0
        End With
        With WdShape.Shadow
            .Style = msoShadowStyleOuterShadow
            .Blur = 0
            .Transparency = 0
            .Size = 0
        End With
        With WdShape.ThreeD
            .BevelBottomType = msoBevelNone
            .BevelBottomDepth = 0
            .BevelBottomInset = 0
            .BevelTopType = msoBevelCircle
            .BevelTopDepth = 0
            .BevelTopInset = 0
            .FieldOfView = 0
            .Perspective = msoFalse
            .PresetMaterial = msoMaterialWarmMatte
            .PresetLighting = msoLightRigTwoPoint
            .LightAngle = 0
        End With
        WdShape.ConvertToInlineShape
    End Sub




    Thanks for all your help!


    • Edited by GordonCHC Friday, November 16, 2012 4:29 PM
    Friday, November 16, 2012 3:17 PM
  • I'm not sure I follow you ultimate objective.  Try:
    Sub ResizePics()
         Dim shp As Word.Shape
         Dim iShp As Word.InlineShape
         Dim rng As Word.Range

        Set rng = Word.ActiveDocument.Bookmarks("\page").Range
         For Each iShp In rng.InlineShapes
             iShp.LockAspectRatio = False
             iShp.Height = Word.InchesToPoints(3.75)
             iShp.Width = Word.InchesToPoints(5)
             AddRoundedDiagonalCorner , iShp
         Next iShp

        For Each shp In rng.ShapeRange
             shp.LockAspectRatio = False
             shp.Height = Word.InchesToPoints(3.75)
             shp.Width = Word.InchesToPoints(5)
             AddRoundedDiagonalCorner shp
         Next shp
     End Sub
     Public Sub AddRoundedDiagonalCorner(Optional ByRef oShpPassed As Shape, Optional ByRef oILSPassed As InlineShape)
         Dim WdShape As Shape
         'Convert to shape.  I could be wrong, but this seems to be the only way to get the rounded corners.
         Set WdShape = oILSPassed.ConvertToShape
         'Round diagonal corners
         WdShape.AutoShapeType = msoShapeRound2DiagRectangle
         With WdShape.Line
             .Weight = 2
             .Style = msoLineSingle
             .ForeColor.RGB = 0
         End With
         WdShape.ConvertToInlineShape
     End Sub

     

    Please visit my website:

    http://gregmaxey.mvps.org/word_tips.html   

    Greg Maxey Please visit my website at: http://gregmaxey.mvps.org/word_tips.htm

    • Marked as answer by GordonCHC Friday, November 16, 2012 8:32 PM
    Friday, November 16, 2012 7:17 PM
  • Thank you so much for your help Greg! I greatly appreciate it! That's exactly what I want!
    Friday, November 16, 2012 8:33 PM
  • OK good. You're welcome

    Greg Maxey Please visit my website at: http://gregmaxey.mvps.org/word_tips.htm

    Friday, November 16, 2012 10:38 PM