Word Macro: Change page orientation depending on image ratio

Question

My macro currently does the following:

It adds a header to a Word document, then reads image files from a specific folder from the HDD and adds them to the same document with the name of the file below the image and a page break after each image. To ensure that the name doesn't get pushed to the next page (if the image fills the whole page), I set the bottom margin to a higher value before adding the image and the name and then set the margin back to the original value. This way the image is a little bit smaller and leaves enough space for the name.

What I now want to add to this:

Switch the orientation of the page depending on the images' width and height and add a manual page break, so I can have multiple orientations in the same document.

But I'm already failing at the first thing:

• How do I get the width/height/ration of the images before adding them to the document (Img.Width doesn't seem to exist in Word)? I don't care what kind of information it is, as long as it tells me if the image is landscape or portrait.
• How do I add a manual page break (Chr(12) just jumps to the next page without adding an actual break)?
• Adding a manual page break also means that my header text won't be used afterwards but how do I set it for the new "Section"? I'm guessing it's not still ActiveDocument.Sections(1) then, is it?

My code (just the image import Sub):

Sub ImportImages(path As String)
    Dim fs As Object
    Dim ff As Variant
    Dim Img As Variant
    Dim i As Long
    Dim fsize As Long
    Dim bottomMarginOriginal As Single
    Dim vertical As Boolean

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ff = fs.GetFolder(path).Files
    i = 0
    fsize = ff.Count
    vertical = True

    With ActiveDocument
        bottomMarginOriginal = .PageSetup.BottomMargin
        .PageSetup.BottomMargin = bottomMarginOriginal + Application.CentimetersToPoints(1) 'Add 1cm to margin

        For Each Img In ff
            Select Case Right(Img.name, 4)
                Case ".bmp", ".jpg", ".gif", ".png", "tiff", ".tif"
                    If i <> 0 Then
                        .Characters.Last.InsertBefore Chr(12) 'Add page break before adding the img
                        Debug.Print "Width: " & Img.Width 'Error message: Doesn't exist!
                    Else
                        .Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "test text"
                        .PageSetup.Orientation = wdOrientLandscape 'TODO: Check the img ratio
                        vertical = False
                    End If

                    i = i + 1
                    .Characters.Last.InlineShapes.AddPicture filename:=Img 'Add the img
                    .Characters.Last.InsertBefore Chr(11) & Img.name 'Add a line break and the img name
            End Select
        Next
    End With
        ActiveDocument.PageSetup.BottomMargin = bottomMarginOriginal
End Sub

Edit:

This code does add section breaks but it seems like it sets the orientation for the whole document, not just the current section, so I end up with the same orientation on all pages, plus the images are only added in the very last section without any page/section breaks in between. How do I fix this?

Sub ImportImages(path As String)
    Dim fs As Object
    Dim ff As Variant
    Dim img As Variant
    Dim i As Long
    Dim fsize As Long
    Dim bottomMarginOriginal As Single
    Dim topMarginOriginal As Single
    Dim vertical As Boolean

    Dim objShell As New Shell
    Dim objFolder As Folder
    Dim objFile As ShellFolderItem

    Dim width As Integer
    Dim height As Integer

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ff = fs.GetFolder(path).Files
    i = 0
    fsize = ff.Count
    vertical = True
    Set objFolder = objShell.NameSpace(path)

    With ActiveDocument
        bottomMarginOriginal = .PageSetup.BottomMargin
        topMarginOriginal = .PageSetup.TopMargin

        For Each img In ff
            Select Case Right(img.name, 4)
                Case ".bmp", ".jpg", ".gif", ".png", "tiff", ".tif"
                    Set objFile = objFolder.ParseName(img.name)
                    width = objFile.ExtendedProperty("{6444048F-4C8B-11D1-8B70-080036B11A03} 3")
                    height = objFile.ExtendedProperty("{6444048F-4C8B-11D1-8B70-080036B11A03} 4")

                    If width > height Then
                        If vertical = False Then 'Already landscape -> just add page break
                            .Characters.Last.InsertBefore Chr(12)
                        Else 'Set to landscape
                            Selection.InsertBreak Type:=wdSectionBreakNextPage
                            .PageSetup.Orientation = wdOrientLandscape
                            .PageSetup.TopMargin = topMarginOriginal 'Adjust margins to new orientation
                            .PageSetup.RightMargin = bottomMarginOriginal
                            .PageSetup.BottomMargin = bottomMarginOriginal
                            .PageSetup.LeftMargin = bottomMarginOriginal
                            .Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "test " & i 'Set header
                            vertical = False
                        End If
                    ElseIf height > width Then
                        If vertical = True Then 'Already portrait -> just add page break on page 2+
                            If i <> 0 Then
                                .Characters.Last.InsertBefore Chr(12)
                            End If
                        Else 'Set to portrait
                            Selection.InsertBreak Type:=wdSectionBreakNextPage
                            .PageSetup.Orientation = wdOrientPortrait
                            .PageSetup.TopMargin = topMarginOriginal 'Adjust margins to new orientation
                            .PageSetup.RightMargin = bottomMarginOriginal
                            .PageSetup.BottomMargin = bottomMarginOriginal
                            .PageSetup.LeftMargin = bottomMarginOriginal
                            .Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "test " & i 'Set header
                            vertical = True
                        End If
                    Else
                        If i <> 0 Then
                            .Characters.Last.InsertBefore Chr(12) 
                        End If
                    End If

                    .PageSetup.BottomMargin = bottomMarginOriginal + Application.CentimetersToPoints(1) 'Add 1cm to the bottom margin
                    i = i + 1
                    .Characters.Last.InlineShapes.AddPicture filename:=img
                    .Characters.Last.InsertBefore Chr(11) & img.name
                    .PageSetup.BottomMargin = bottomMarginOriginal 'Reset bottom margin to default
            End Select
        Next
    End With
End Sub

Answer 1

You don't need to get the image dimensions beforehand. Try something along the lines of:

Sub AddPics()
Application.ScreenUpdating = False
Dim i As Long, StrTxt As String, Rng As Range, vCol
Dim sAspect As Single, sLndWdth As Single, sLndHght As Single
Dim sMgnL As Single, sMgnR As Single, sMgnT As Single, sMgnB As Single, sMgnG As Single
'Select and insert the Pics
With Application.FileDialog(msoFileDialogFilePicker)
  .Title = "Select image files and click OK"
  .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
  .FilterIndex = 2
  If .Show = -1 Then
    Set vCol = .SelectedItems
  Else
    Exit Sub
  End If
End With
With ActiveDocument
  'Create a paragraph Style with 0 space before/after & centre-aligned
  On Error Resume Next
  .Styles.Add Name:="Pic", Type:=wdStyleTypeParagraph
  With .Styles("Pic").ParagraphFormat
    .Alignment = wdAlignParagraphCenter
    .SpaceAfter = 0
    .SpaceBefore = 0
  End With
  On Error GoTo 0
  With .PageSetup
    sMgnL = .LeftMargin: sMgnR = .RightMargin: sMgnT = .TopMargin: sMgnB = .BottomMargin: sMgnG = .Gutter
  End With
  Set Rng = Selection.Range
  With Rng
    .Paragraphs.Last.Style = "Pic"
    For i = 1 To vCol.Count
      .InsertAfter vbCr
      .Characters.Last.InsertBreak Type:=wdSectionBreakNextPage
      .InlineShapes.AddPicture FileName:=vCol(i), LinkToFile:=False, SaveWithDocument:=True, Range:=.Characters.Last
      'Get the Image name for the Caption
      StrTxt = Split(Split(vCol(i), "\")(UBound(Split(vCol(i), "\"))), ".")(0)
      'Insert the Caption below the picture
      .Characters.Last.InsertBefore Chr(11) & StrTxt
    Next
    .Characters.First.Text = vbNullString
    .Characters.Last.Previous.Text = vbNullString
    For i = 1 To .InlineShapes.Count
      With .InlineShapes(i)
        'Reorient pages for landscape pics
        If .Height / .Width < 1 Then
          With .Range.Sections(1).PageSetup
            .Orientation = wdOrientLandscape
            .LeftMargin = sMgnL: .RightMargin = sMgnR: .TopMargin = sMgnT: .BottomMargin = sMgnB: .Gutter = sMgnG
            sLndWdth = .PageWidth - sMgnL - sMgnR - sMgnG
            sLndHght = .PageHeight - sMgnT - sMgnB
          End With
          .LockAspectRatio = True
          .ScaleHeight = 100
          If .Height > sLndHght Then .Height = sLndHght
          If .Width > sLndWdth Then .Width = sLndWdth
        End If
      End With
    Next
  End With
End With
Application.ScreenUpdating = True
End Sub