Insert a picture in the footer in a table cell for each section

[MaryLouP]

I have used this code in other documents and it works fine however I now have a document that has a section break due to the last couple pages being landscape. I tried to write code that goes to the next section, to the proper cell and inserts the picture which was chosen from the Browse button but an error appears after it does insert the picture in section 2, the landscape section. I tried other lines of code but keep getting an error. The additional code I added is in found by the NOTE:. Any help is greatly appreciated!

Sub LogoLandscape2()

Dim PictureNow As String
Dim InsertPics1 As Integer
Dim dlgOpen As FileDialog
Dim t As InlineShape
Dim PercentSize As Integer
    PercentSize = 40



Set dlgOpen = Application.FileDialog( _
    FileDialogType:=msoFileDialogFilePicker)
dlgOpen.AllowMultiSelect = False
    
'Inserts logo on first page within the text box
    
    ActiveDocument.Shapes.Range(Array("Text Box 2")).Select
    Selection.GoTo Name:="ClientLogo"
    Selection.EndKey Unit:=wdLine
    Selection.TypeParagraph
 
    If dlgOpen.Show = -1 Then
        Selection.InlineShapes.AddPicture _
            FileName:=dlgOpen.SelectedItems(1)
    End If
   
    Selection.EndKey Unit:=wdLine
    Selection.TypeParagraph
        
' Goes into footer; inserts logo into second cell and resizes

    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    ActiveWindow.ActivePane.View.NextHeaderFooter
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdCell
    
Set t = Selection.InlineShapes.AddPicture(dlgOpen.SelectedItems(1))
With t
.ScaleHeight = PercentSize
.ScaleWidth = PercentSize


End With

'***
'NOTE: After inserting the picture in the correct cell get an error, does not do resize and returns to main document
'Next footer landscape pages
    ActiveWindow.ActivePane.View.NextHeaderFooter
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdCell
    Selection.InlineShapes.AddPicture (dlgOpen.SelectedItems(1))
    
'***

'Return to main document
 ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    Selection.HomeKey Unit:=wdStory



End Sub

[gmayor]

If there is a table in each footer of each section then the following will put a selected image into the first row second cell of that table and the image will shrink to the width of the cell.

Sub Logo()
Dim fDialog As FileDialog
Dim strLogo As String
Dim oTable As Table
Dim oCell As Range
Dim oSection As Section
Dim oFooter As HeaderFooter

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Graphics Files", "*.jpg,*.png,*.tif, *.bmp, *.gif"
        .InitialFileName = Environ("USERPROFILE") & "\Pictures\"
        .InitialView = msoFileDialogViewList
        If Not .Show = -1 Then
            MsgBox "User cancelled"
            GoTo lbl_Exit
        End If
    End With
    strLogo = fDialog.SelectedItems(1)

    For Each oSection In ActiveDocument.Sections
        For Each oFooter In oSection.Footers
            If oFooter.Exists Then
                If oFooter.Range.Tables.Count > 0 Then
                    Set oTable = oFooter.Range.Tables(1)
                    If oTable.Rows(1).Cells.Count > 1 Then
                        oTable.AutoFitBehavior wdAutoFitFixed
                        Set oCell = oTable.Cell(1, 2).Range
                        oCell.End = oCell.End - 1
                        oCell.Text = ""
                        oCell.InlineShapes.AddPicture strLogo
                    End If
                End If
            End If
        Next oFooter
    Next oSection
lbl_Exit:
    Set oSection = Nothing
    Set oFooter = Nothing
    Set oTable = Nothing
    Set oCell = Nothing
    Exit Sub
End Sub