简体   繁体   中英

Excel VBA Footer Image

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM