![]() |
|
|
|
#1
|
|||
|
|||
|
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 |
|
#2
|
||||
|
||||
|
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 |
|
| Tags |
| footer, picture, section |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
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 |
Macro to insert picture in footer
|
Sharon | Word | 5 | 01-29-2013 03:12 AM |
Picture inserted in cell of table is not visible
|
peytontodd | Word | 1 | 12-07-2012 08:36 PM |