Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Dec 2015
    Posts
    6
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Talking Macro to set absolute locations for multiple images

    Basically, I have hundreds of photos but want them formatted in a specific way, depending on if there is on, two or three pictures on a page.

    I was trying to get the macro to:
    -count the # of pics on page one
    -format to specific location and size
    -go to page two...ect

    Here's what I got and I'm getting hung up on for statements:


    Code:
    Sub Master()
                                    'Variables
        Dim i As Integer
        Dim intCounter As Integer
        Dim ICnt As Integer
        Dim oShp As Shape
        Dim Width As Double, Left As Double
        Dim TPage As Integer
    
    
        TPage = 50                  'this is how many pages you have
    
            'For i = 1 To TPage Step 1
            For Each oShp In ActiveDocument.Shapes
                If (ICnt) = 0 Then
                    End If
                If (ICnt) = 1 Then
                    With oShp
                    .LockAspectRatio = msoTrue
                    .Width = InchesToPoints(5)
                    .Left = InchesToPoints(0.55)
                    .Top = InchesToPoints(3.13)
                    End With
                If (ICnt) = 2 Then 'If page has two images then use
                                    'these absolute location settings
                    With oShp
                    .LockAspectRatio = True
                    .Height = InchesToPoints(Height)
                    .Width = InchesToPoints(5)
                    Dim k As Long, j As Single
                        With ActivePage
                        For k = 1 To .InlineShapes.Count
                        With .InlineShapes(i)
                        'j = InchesToPoints(5) / .Height
                        '.Height = InchesToPoints(5)
                        '.Width = .Width * j
                        .Left = InchesToPoints(0.55)
                        .Top = InchesToPoints(1.55)
                        End With
                    Next k
                        With .InlineShapes(i)
                        .Left = InchesToPoints(0.55)
                        .Top = InchesToPoints(5.55)
                        End With
                    If (ICnt) = 3 Then
                        .Height = InchesToPoints(3.45)
                        .Width = InchesToPoints(4.6)
                    Dim l As Long, m As Single
                    With ActivePage
                    For l = 1 To .InlineShapes.Count
                        With .InlineShapes(l)
                        'j = InchesToPoints(5) / .Height
                        '.Height = InchesToPoints(5)
                        '.Width = .Width * j
                        .Left = InchesToPoints(0.27)
                        .Top = InchesToPoints(0.25)
                        End With
                        Next l
                        l = 2
                        With .InlineShapes(l)
                        .Left = InchesToPoints(0.27)
                        .Top = InchesToPoints(3.75)
                        End With
                        l = 3
                        With .InlineShapes(l)
                        .Left = InchesToPoints(0.27)
                        .Top = InchesToPoints(7.25)
                        End With
    
    
        End With
        End If
        End With
        End With
        End If
        End If
        Next
        End Sub

    Any Help would be super appreciated!
    Thanks guys.
    Last edited by macropod; 2015-12-15 at 20:15. Reason: Replaced code colouring with code tags

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    I can't tell from your code whether the pictures have been inserted as shape objects or inlineshape objects, or a mix of both. You seem to swap willy-nilly between the two formats. Your code also lacks structure and uses terms like 'ActivePage' that are unknown to Word.

    Ambiguous as your code is, it appears you're trying to do something like:
    Code:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long, Rng As Range
    With ActiveDocument
      For i = 1 To .ComputeStatistics(wdStatisticPages)
        Set Rng = .GoTo(What:=wdGoToPage, Name:=i)
        Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
        With Rng
          Select Case .ShapeRange.Count
            Case 1
              With .ShapeRange(1)
                .LockAspectRatio = msoTrue
                .Width = InchesToPoints(5)
                .Left = InchesToPoints(0.55)
                .Top = InchesToPoints(3.13)
              End With
            Case 2
              With .ShapeRange(1)
                .LockAspectRatio = msoTrue
                .Width = InchesToPoints(5)
                .Left = InchesToPoints(0.55)
                .Top = InchesToPoints(1.55)
              End With
              With .ShapeRange(2)
                .LockAspectRatio = msoTrue
                .Width = InchesToPoints(5)
                .Left = InchesToPoints(0.55)
                .Top = InchesToPoints(5.55)
              End With
            Case 3
              With .ShapeRange(1)
                .LockAspectRatio = msoTrue
                .Width = InchesToPoints(4.6)
                .Left = InchesToPoints(0.27)
                .Top = InchesToPoints(0.25)
              End With
              With .ShapeRange(2)
                .LockAspectRatio = msoTrue
                .Width = InchesToPoints(4.6)
                .Left = InchesToPoints(0.27)
                .Top = InchesToPoints(3.75)
              End With
              With .ShapeRange(3)
                .LockAspectRatio = msoTrue
                .Width = InchesToPoints(4.6)
                .Left = InchesToPoints(0.27)
                .Top = InchesToPoints(7.25)
              End With
          End Select
        End With
      Next
    End With
    Application.ScreenUpdating = True
    End Sub
    Note that the above code is for Shape objects only; InlineShape objects are not included.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  3. #3
    New Lounger
    Join Date
    Dec 2015
    Posts
    6
    Thanks
    0
    Thanked 0 Times in 0 Posts
    [QUOTE=macropod;1036231]I can't tell from your code whether the pictures have been inserted as shape objects or inlineshape objects, or a mix of both. You seem to swap willy-nilly between the two formats. Your code also lacks structure and uses terms like 'ActivePage' that are unknown to Word.
    Yes, I meant just shapes.

    That was impressively quick thanks, Macropod! I ran a test with a mix of all combinations. Two things I noticed:
    1) The last page of pictures didn't get resized/relocated.
    2) Random pictures would be not be relocated correctly

    Overall, I appreciate the time you now save me.

    I just learned about macros today believe it or not and I'm sure I will learn much more in the coming days.
    Since I'm ignorant of many functions:
    how could one compress the photos?
    add one box per page? (using the same location method I assume. B ut are they considered objects inline?)
    Attached Images Attached Images

  4. #4
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Aside from the last page, if some pics aren't being processed, that would be because:
    1. they're formatted as InlineShapes, not Shapes; or
    2. There are more than 3 on the page.
    Try the following revision to the code. It: converts all InlineShapes to Shapes; processes the last page correctly; sets the top & left positions relative to the margins, so consistent left & top positions can be applied; centres the pics horizontally between the margins; and calculates the vertical postions for the 2nd & subsequent pics on a page according to the height & position of the previous ones.
    Code:
    Sub Demo()
    Application.ScreenUpdating = False
    Dim i As Long, Rng As Range, vPos As Single
    With ActiveDocument
      While .InlineShapes.Count > 0
        .InlineShapes(1).ConvertToShape
      Wend
      For i = 1 To .ComputeStatistics(wdStatisticPages)
        Set Rng = .GoTo(What:=wdGoToPage, Name:=i)
        Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
        If i = .ComputeStatistics(wdStatisticPages) Then
          Rng.End = .Range.End
        End If
        With Rng
          Select Case .ShapeRange.Count
            Case 1
              vPos = InchesToPoints(3.13)
              With .ShapeRange(1)
                .LockAspectRatio = msoTrue
                .Width = InchesToPoints(5)
                .LeftRelative = wdRelativeHorizontalPositionMargin
                .TopRelative = wdRelativeVerticalPositionMargin
                .Left = wdShapeCenter
                .Top = vPos
              End With
            Case 2
              vPos = InchesToPoints(1.55)
              With .ShapeRange(1)
                .LockAspectRatio = msoTrue
                .LeftRelative = wdRelativeHorizontalPositionMargin
                .TopRelative = wdRelativeVerticalPositionMargin
                .Width = InchesToPoints(5)
                .Left = wdShapeCenter
                .Top = vPos
                vPos = vPos + .Height + InchesToPoints(0.25)
              End With
              With .ShapeRange(2)
                .LockAspectRatio = msoTrue
                .LeftRelative = wdRelativeHorizontalPositionMargin
                .TopRelative = wdRelativeVerticalPositionMargin
                .Width = InchesToPoints(5)
                .Left = wdShapeCenter
                .Top = vPos
              End With
            Case 3
              vPos = InchesToPoints(0.25)
              With .ShapeRange(1)
                .LockAspectRatio = msoTrue
                .LeftRelative = wdRelativeHorizontalPositionMargin
                .TopRelative = wdRelativeVerticalPositionMargin
                .Width = InchesToPoints(4.6)
                .Left = wdShapeCenter
                .Top = vPos
                vPos = vPos + .Height + InchesToPoints(0.25)
              End With
              With .ShapeRange(2)
                .LockAspectRatio = msoTrue
                .LeftRelative = wdRelativeHorizontalPositionMargin
                .TopRelative = wdRelativeVerticalPositionMargin
                .Width = InchesToPoints(4.6)
                .Left = wdShapeCenter
                .Top = vPos
                vPos = vPos + .Height + InchesToPoints(0.25)
              End With
              With .ShapeRange(3)
                .LockAspectRatio = msoTrue
                .LeftRelative = wdRelativeHorizontalPositionMargin
                .TopRelative = wdRelativeVerticalPositionMargin
                .Width = InchesToPoints(4.6)
                .Left = wdShapeCenter
                .Top = vPos
              End With
          End Select
        End With
      Next
    End With
    Application.ScreenUpdating = True
    End Sub
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  5. #5
    New Lounger
    Join Date
    Dec 2015
    Posts
    6
    Thanks
    0
    Thanked 0 Times in 0 Posts
    1. they're formatted as InlineShapes, not Shapes; or
    It: converts all InlineShapes to Shapes; processes the last page correctly; sets the top & left positions relative to the margins, so consistent left & top positions can be applied; centres the pics horizontally between the margins; and calculates the vertical postions for the 2nd & subsequent pics on a page according to the height & position of the previous ones.

    I figured out why there were random images out of whack. It was because under picture layout>advanced tab>move object with text was still checked.
    As for the revised code changing all the inline shapes to shapes would mess up all my text boxes already in place so I took that out. Is there a code to auto uncheck these boxes or can I change the default somewhere under WORD settings?

    I made a macro to delete all the textboxes and the code worked by the way. With them mixed in with the pictures code was no good.
    Last edited by HolyMacroni; 2015-12-16 at 09:32.

  6. #6
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    If you don't want to convert InlineShapes to Shapes you can delete:
    Code:
      While .InlineShapes.Count > 0
        .InlineShapes(1).ConvertToShape
      Wend
    The 'move with text' option pror to running the macro shouldn't have any effect, as the macro sets the positioning relative to the margins, not to any paragraphs/characters.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •