Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

powerpoint vba to remove header footer, page numbers and date

Status
Not open for further replies.

sxschech

Technical User
Jul 11, 2002
1,033
US
I found code to hide the page numbers and date from powerpoint 2013, which I assumed would have the same effect as clicki on View, Handout Master and unticking Date and Page Number in the Placeholders section and then print the result to pdf with two slides per page without saving the pptx file. I tried two versions of the code, commented out and uncommented and the only part that works is saving the file to pdf. There are no error messages or code stoppage. Unfortunately, when I open the pdf, the headers and footers are still there for the date and page number. (I also originally tried the code within powerpoint's vba module rather than through automation and it didn't work there either)

Code:
Private Sub btnPPT2PDF_Click()
'zapper()
'[URL unfurl="true"]http://www.vbaexpress.com/forum/showthread.php?29698-Simple-Powerpoint-Macro-Remove-Page-Numbers-Footers-Etc[/URL]
'post 9
'[URL unfurl="true"]http://peltiertech.com/Excel/XL_PPT.html[/URL]
'20170413
    Dim PPApp As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    Dim stFileName As String

    ' Reference instance of PowerPoint
    On Error Resume Next
    ' Check whether PowerPoint is running
    Set PPApp = GetObject(, "PowerPoint.Application")
    If PPApp Is Nothing Then
        ' PowerPoint is not running, create new instance
        Set PPApp = CreateObject("PowerPoint.Application")
        ' For automation to work, PowerPoint must be visible
        PPApp.Visible = True
    End If
    On Error GoTo 0
        
    stFileName = "c:\temp\MyPowerPointFile.pptx" 
    
    PPApp.Presentations.Open (stFileName)
    
    Set PPPres = PPApp.ActivePresentation
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
    
    '[URL unfurl="true"]http://bettersolutions.com/powerpoint/PZZ583/VI114366552.htm[/URL]
    With PPPres.SlideMaster.HeadersFooters
        .DateAndTime.Visible = msoFalse
        .Footer.Visible = msoFalse
        .SlideNumber.Visible = msoFalse
    End With
    'For Each PPSlide In PPApp.ActivePresentation.Slides
    '    With PPSlide.HeadersFooters
    '        .DateAndTime.Visible = msoFalse
    '        .Footer.Visible = msoFalse
    '        .SlideNumber.Visible = msoFalse
    '    End With
    'Next PPSlide
    '[URL unfurl="true"]https://msdn.microsoft.com/en-us/library/office/ff746080.aspx[/URL]
    PPApp.ActivePresentation.ExportAsFixedFormat "C:\temp\PPT2PDF.pdf", ppFixedFormatTypePDF, ppFixedFormatIntentScreen, msoTrue, ppPrintHandoutHorizontalFirst, ppPrintOutputTwoSlideHandouts, msoFalse, , , , False, False, False, False, False
    
Error_Handler_Exit:
    On Error Resume Next
    PPApp.Quit
    Set PPTslide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: OpenPPT" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit

End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top