Microsoft Office Forums - View Single Post - Insert a picture in the footer in a table cell for each section

MaryLouP · 01-18-2018, 01:09 PM

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!

Code:

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