VBA - Error with pasting headers and footers from Excel to Word

Jasesair

Board Regular
Joined
Apr 8, 2015
Messages
241
Office Version
  1. 2016
I have this section of code to be able to paste a range in Excel as a image into Word headers and footers. It was working perfectly to paste in the header but my efforts to copy the code to paste the footer has failed. The end result is the footer range has pasted correctly but has also pasted the footer range into the header.

Any assistance to correct this would be fantastic. Appreciate any support.

VBA Code:
 'Change the view to header & footer
If WordApp.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
WordApp.ActiveWindow.Panes(2).Close
End If

'Select the Header range and paste as image
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False

'Select the Footer range and paste as image
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False

WordApp.ActiveWindow.View.Type = wdNormalView
WordApp.ActiveWindow.View.Type = wdPrintView
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
Your code includes 2 instructions
- paste copiedRange into header
- paste copiedRange into footer

But you are not amending the copied range between the 2 instructions
So you need something like this ...

Rich (BB code):
'Change the view to header & footer
If WordApp.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
WordApp.ActiveWindow.Panes(2).Close
End If

'Select the Header range and paste as image
copiedRangeA.Copy
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False

'Select the Footer range and paste as image
copiedRangeB.Copy
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False

WordApp.ActiveWindow.View.Type = wdNormalView
WordApp.ActiveWindow.View.Type = wdPrintView
 

Watch MrExcel Video

Forum statistics

Threads
1,130,051
Messages
5,639,773
Members
417,112
Latest member
PachRedoc

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top