Adding Picture from worksheet to Header (VBA)

[Flycrj]

Hi,

I'm Trying to add a picture from the worksheet (Picture 1) to the header and I'm getting a Run-time error '438' Object doesn't support this property or method.

The error happens on this line ActiveSheet.PageSetup.CenterHeaderPicture = ActiveSheet.Shapes.Range(Array("Picture 1"))

Thanks for your Help!

 

[John_w]

Welcome to Mr Excel forums.

You have to save the picture (shape) as a (temporary) image file and insert the file in the header with the "&G" formatting code. Try this macro:

Public Sub Setup_Page_Header()

    Dim shp As Shape
    Dim tempImageFile As String
       
    Set shp = ActiveSheet.Shapes("Picture 1")
   
    'Save the shape as a temporary image file
   
    tempImageFile = Environ("temp") & "\image.bmp"
    Save_Object_As_Bitmap shp, tempImageFile
   
    'Add the file to the page header
   
    With ActiveSheet.PageSetup
        .CenterHeaderPicture.Filename = tempImageFile
        .CenterHeader = "&G"
    End With

    Kill tempImageFile
   
End Sub


Private Sub Save_Object_As_Bitmap(saveObject As Object, imageFileName As String)

    'Save an object in bitmap format.
   
    'Arguments
    'saveObject     - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
    'imageFileName  - the .bmp, .gif, .jpg, or .png file name (including folder path if required) the object will be saved as
   
    Dim temporaryChart As ChartObject
    
    saveObject.CopyPicture xlScreen, xlBitmap
   
    Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width + 6, saveObject.Height + 6)
    With temporaryChart
        .Activate                                'Required, otherwise image is blank with Excel 2016
        .Border.LineStyle = xlLineStyleNone      'No border
        .Chart.Paste
        .Chart.Export imageFileName
        .Delete
    End With
   
    Set temporaryChart = Nothing
   
End Sub

 

[Flycrj]

Thanks John!!! Works Great

 

[sharifadabi]

I still cannot use the code for the header in the first page:

FirstPage.CenterHeader.Picture.Filename = tempImageFile

it receives the same error

 

[John_w]

I still cannot use the code for the header in the first page:

FirstPage.CenterHeader.Picture.Filename = tempImageFile

it receives the same error

Try this macro. It puts the first picture (shape) on the active sheet in the header for the first page and the second picture for the other page(s).

Public Sub Setup_Page_Header_Different_First_Page()

    Dim shpFirstPage As Shape, shpOtherPages As Shape
    Dim tempImageFile1 As String, tempImageFile2 As String
       
    Set shpFirstPage = ActiveSheet.Shapes(1)
    Set shpOtherPages = ActiveSheet.Shapes(2)
   
    'Save the shapes as temporary image files
   
    tempImageFile1 = Environ("temp") & "\image1.bmp"
    Save_Object_As_Bitmap shpFirstPage, tempImageFile1
    tempImageFile2 = Environ("temp") & "\image2.bmp"
    Save_Object_As_Bitmap shpOtherPages, tempImageFile2
   
    'Add the images to the first page header and other pages
   
    With ActiveSheet.PageSetup
        .DifferentFirstPageHeaderFooter = True
        .FirstPage.CenterHeader.Picture.Filename = tempImageFile1
        .FirstPage.CenterHeader.Text = "&G"
        .CenterHeaderPicture.Filename = tempImageFile2
        .CenterHeader = "&G"
    End With

    Kill tempImageFile1
    Kill tempImageFile2
   
End Sub

Private Sub Save_Object_As_Bitmap(saveObject As Object, imageFileName As String)

    'Save an object in bitmap format.
  
    'Arguments
    'saveObject     - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
    'imageFileName  - the .bmp, .gif, .jpg, or .png file name (including folder path if required) the object will be saved as
  
    Dim temporaryChart As ChartObject
   
    saveObject.CopyPicture xlScreen, xlBitmap
  
    Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width + 6, saveObject.Height + 6)
    With temporaryChart
        .Activate                                'Required, otherwise image is blank with Excel 2016
        .Border.LineStyle = xlLineStyleNone      'No border
        .Chart.Paste
        .Chart.Export imageFileName
        .Delete
    End With
  
    Set temporaryChart = Nothing
  
End Sub