footer on last page only

[BORUCH]

hi all

can i please get a vba that inputs a picture from my documents folder as a footer on my excel sheet when i print it to pdf it should only put it on the last page only

and also if it will block data (data behind the picture) it should move it down another page

thanks

 

[BORUCH]

Any suggestions?

 

[John_w]

I don't think this can be done with the normal sheet footer; only the first page can have a header or footer which is different to the other pages.

This macro inserts the specified picture directly in the cells at the bottom left of the last page (not in the normal sheet footer), ensuring it doesn't overlay the data.

Public Sub Save_Sheet_As_PDF_With_Picture_Footer_On_Last_Page()

    Dim pictureFile As String
    Dim PDFoutputFile As String
    Dim currentView As XlWindowView
    Dim rowsPerPage As Long
    Dim lastDataRow As Long
    Dim lastPageLastRow As Long
    Dim picShape As Shape
    Dim footerCell As Range
  
    pictureFile = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\My picture.png"   'CHANGE FILE NAME OF PICTURE
   
    PDFoutputFile = ThisWorkbook.Path & "\Sheet with last page footer.pdf"  'CHANGE PDF FILE NAME & PATH
   
    Application.ScreenUpdating = False
   
    With ActiveWindow
        currentView = .View
        .View = xlPageBreakPreview
    End With

    With ActiveSheet
   
        .ResetAllPageBreaks

        If .HPageBreaks.Count > 0 Then
            'Get the number of rows per page by reading the row number of the first page break
            rowsPerPage = .HPageBreaks(1).Location.Row - 1
        Else
            'No page breaks, so assume 50 rows per page
            rowsPerPage = 50
        End If
       
        'Get the row number of the last data row
        lastDataRow = .UsedRange.Rows.Count + .UsedRange.Rows(1).Row - 1
       
        'Get the row number of the last row on the last page
        lastPageLastRow = (.HPageBreaks.Count + 1) * rowsPerPage
       
        'Add the picture at (0,0) so that its Height (and Width) can be read
        Set picShape = .Shapes.AddPicture(pictureFile, False, True, 0, 0, -1, -1)
       
        'Get the cell immediately below the last row on the last page.  The Top of this cell is the bottom of the last row on the last page
        Set footerCell = .Cells(lastPageLastRow + 1, 1)
           
        'Would the picture overlay the data?       
        If footerCell.Top - 1 - picShape.Height < .Cells(lastDataRow + 1, 1).Top Then
            'Yes, so add a new page break and get the cell immediately below the last row on the new page. The Top of this cell is the bottom of the last row on the last page
            .HPageBreaks.Add Before:=.Cells(lastPageLastRow + 1, 1).EntireRow
            Set footerCell = .Cells(lastPageLastRow + rowsPerPage + 1, 1)
        End If
       
        'Reposition picture at bottom of last page.  picShape.Left stays 0, so picture is on far left of page
        picShape.Top = footerCell.Top - 1 - picShape.Height
       
    End With
   
    'Save sheet as the PDF
   
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFoutputFile, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=True
   
    picShape.Delete
       
    ActiveWindow.View = currentView
   
    Application.ScreenUpdating = False

End Sub

 

[BORUCH]

I don't think this can be done with the normal sheet footer; only the first page can have a header or footer which is different to the other pages.

This macro inserts the specified picture directly in the cells at the bottom left of the last page (not in the normal sheet footer), ensuring it doesn't overlay the data.

Public Sub Save_Sheet_As_PDF_With_Picture_Footer_On_Last_Page()

    Dim pictureFile As String
    Dim PDFoutputFile As String
    Dim currentView As XlWindowView
    Dim rowsPerPage As Long
    Dim lastDataRow As Long
    Dim lastPageLastRow As Long
    Dim picShape As Shape
    Dim footerCell As Range
 
    pictureFile = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\My picture.png"   'CHANGE FILE NAME OF PICTURE
  
    PDFoutputFile = ThisWorkbook.Path & "\Sheet with last page footer.pdf"  'CHANGE PDF FILE NAME & PATH
  
    Application.ScreenUpdating = False
  
    With ActiveWindow
        currentView = .View
        .View = xlPageBreakPreview
    End With

    With ActiveSheet
  
        .ResetAllPageBreaks

        If .HPageBreaks.Count > 0 Then
            'Get the number of rows per page by reading the row number of the first page break
            rowsPerPage = .HPageBreaks(1).Location.Row - 1
        Else
            'No page breaks, so assume 50 rows per page
            rowsPerPage = 50
        End If
      
        'Get the row number of the last data row
        lastDataRow = .UsedRange.Rows.Count + .UsedRange.Rows(1).Row - 1
      
        'Get the row number of the last row on the last page
        lastPageLastRow = (.HPageBreaks.Count + 1) * rowsPerPage
      
        'Add the picture at (0,0) so that its Height (and Width) can be read
        Set picShape = .Shapes.AddPicture(pictureFile, False, True, 0, 0, -1, -1)
      
        'Get the cell immediately below the last row on the last page.  The Top of this cell is the bottom of the last row on the last page
        Set footerCell = .Cells(lastPageLastRow + 1, 1)
          
        'Would the picture overlay the data?      
        If footerCell.Top - 1 - picShape.Height < .Cells(lastDataRow + 1, 1).Top Then
            'Yes, so add a new page break and get the cell immediately below the last row on the new page. The Top of this cell is the bottom of the last row on the last page
            .HPageBreaks.Add Before:=.Cells(lastPageLastRow + 1, 1).EntireRow
            Set footerCell = .Cells(lastPageLastRow + rowsPerPage + 1, 1)
        End If
      
        'Reposition picture at bottom of last page.  picShape.Left stays 0, so picture is on far left of page
        picShape.Top = footerCell.Top - 1 - picShape.Height
      
    End With
  
    'Save sheet as the PDF
  
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFoutputFile, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:=True
  
    picShape.Delete
      
    ActiveWindow.View = currentView
  
    Application.ScreenUpdating = False

End Sub

hi thanks for your answer two problems i want it to be in the center and for some reason its creating an additional empty page not sure why

 

[John_w]

Press Ctrl+End on the sheet to find the last used cell and ensure it really is the last cell with data. The code uses the same cell (i.e. UsedRange) to decide the row position of the picture.

Debug the code (press F8 to step through it line by line) and ensure the values of variables are correct. There are enough comments in the code which explain what it's doing.

The code adds a page break only if required, so debug it and ensure the If statement is deciding correctly and if so whether the page break is being put in the correct place.

For centring the picture, add these changes; again it's based on the sheet's UsedRange:

    Dim lastDataColumn As Long

        'Get the column number of the last data column
        lastDataColumn = .UsedRange.Columns.Count + .UsedRange.Columns(1).Count - 1

        'Reposition picture at bottom centre of last page
        picShape.Top = footerCell.Top - 1 - picShape.Height
        picShape.Left = (.Cells(1, lastDataColumn + 1).Left - 1 - picShape.Width) / 2