Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-18-2018, 01:09 PM
MaryLouP MaryLouP is offline Insert a picture in the footer in a table cell for each section Windows 10 Insert a picture in the footer in a table cell for each section Office 2016
Novice
Insert a picture in the footer in a table cell for each section
 
Join Date: Jan 2018
Posts: 2
MaryLouP is on a distinguished road
Default Insert a picture in the footer in a table cell for each section

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

Last edited by macropod; 01-18-2018 at 03:08 PM. Reason: Added code tags
Reply With Quote
  #2  
Old 01-19-2018, 03:16 AM
gmayor's Avatar
gmayor gmayor is offline Insert a picture in the footer in a table cell for each section Windows 10 Insert a picture in the footer in a table cell for each section Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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.

Code:
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
Reply

Tags
footer, picture, section



Similar Threads
Thread Thread Starter Forum Replies Last Post
Insert a picture in the footer in a table cell for each section Anytime a section of TOC is updated, the picture stored in that section gets copied into my TOC. brap367 Word 1 12-15-2014 12:49 PM
Picture in table cell not visible peytontodd Word 5 09-23-2014 11:41 PM
Insert a TOC inside a table cell simobk Word 3 10-28-2013 01:18 PM
Insert a picture in the footer in a table cell for each section Macro to insert picture in footer Sharon Word 5 01-29-2013 03:12 AM
Insert a picture in the footer in a table cell for each section Picture inserted in cell of table is not visible peytontodd Word 1 12-07-2012 08:36 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 08:10 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft