Is there a way to use Excel-VBA code in order to make a picture object in a sheet, so as to insert it as a footer image. I have tried to do so by creating a chart object and pasting it in a picture-format, and then exporting the chart to an image file and setting the image as the footer. Is there a better way to insert a picture object as a footer image, and if so, how do I do it?
For anybody viewing this in the future, I'll share my code to copy a range and save it as a file on your computer, which can then be added to the footer. You can eliminate whatever bits you don't want =)
Dim objPic As Shape
Dim objChart As Chart
Dim strTimeStamp As String
Dim strFileDest As String
20 Sheets(2).Activate
30 Sheets(2).Columns("R:T").AutoFit
40 Sheets(2).Rows("17:21").AutoFit
50 ActiveWindow.DisplayGridlines = False
60 Call Sheets(2).Range("S17", "U21").CopyPicture(xlScreen, xlPicture)
70 ActiveWindow.DisplayGridlines = True
80 Sheets(2).Shapes.AddChart
90 Sheets(2).Activate
100 Sheets(2).Shapes.Item(1).Select
110 Set objChart = ActiveChart
120 ActiveChart.Parent.Name = "FooterChart"
' For some reason, Excel occasionally tries to make an actual chart out of these strings.
' It's just a nonsensical chart that messes the footer up but I'm having trouble duplicating the issue and figuring out what causes it.
' This should always work. Don't use .Clear, it crashes.
130 ActiveChart.ChartArea.ClearContents
140 objChart.Paste
150 Selection.Name = "FooterImage"
160 ActiveSheet.ChartObjects("FooterChart").Activate
170 Sheets(2).Shapes.Item(1).Line.Visible = msoFalse
180 Sheets(2).Shapes.Item(1).Height = Range("S17", "U21").Height
190 Sheets(2).Shapes.Item(1).Width = Range("S17", "U21").Width
200 ActiveChart.Shapes.Range(Array("FooterImage")).Height = Range("S17", "U21").Height
210 ActiveChart.Shapes.Range(Array("FooterImage")).Width = Range("S17", "U21").Width
220 Sheets(2).Shapes.Item(1).Height = Sheets(2).Shapes.Item(1).Height * 1.25
230 Sheets(2).Shapes.Item(1).Width = Sheets(2).Shapes.Item(1).Width * 1.25
240 ActiveChart.Shapes.Range(Array("FooterImage")).Height = ActiveChart.Shapes.Range(Array("FooterImage")).Height * 1.2
250 ActiveChart.Shapes.Range(Array("FooterImage")).Width = ActiveChart.Shapes.Range(Array("FooterImage")).Width * 1.2
260 strTimeStamp = CStr(Format(Now(), "yyyymmddHhNnSs"))
270 strFileDest = "D:\Temp" & strTimeStamp & ".jpg"
280 objChart.Export strFileDest
290 InsertPicture strFileDest
300 If Len(Dir$(strFileDest)) > 0 Then
310 Kill strFileDest
320 End If
330 Sheets(2).Shapes.Item(1).Delete
I started the macro recorder. I clicked Page Setup
then Header/Footer
then Custom Footer
. I clicked the centre section and then Format Picture
(button with image of sun over mountains). I browsed for an image and clicked Insert
. "&[Picture]" appeared in the centre section. I clicked OK
twice. I switched the macro recorder off.
I printed the page and the selected image appeared at the bottom.
The important code saved by the macro recorder was:
ActiveSheet.PageSetup.CenterFooterPicture.Filename = _
"C:\Users\Public\Pictures\Sample Pictures\Desert Landscape.jpg"
Replace "C:\\Users\\Public\\Pictures\\Sample Pictures\\Desert Landscape.jpg"
with filename of your choice.
The macro recorder is usually the easiest way of discovering statements like this.
Try this:
Dim ws as Worksheet
Set ws = Worksheets("YourWorksheetName")
With ws.PageSetup
.CenterFooterPicture = "&G" 'Specifies that you want an image in your footer
.CenterFooterPicture.Filename = "C:\Pictures\MyFooterImage.jpg" 'specifies the image file you want to use
End With
The code generated by the macro recorder will get you part of the way there, but as is often the case, it doesn't provide the whole or most appropriate solution. It also sounds like you are trying to insert an image generated by Excel (such as a chart) into the footer? if that's the case, I believe you will have to same the object as an image and then reference that image file.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.