bujom
bujom

Reputation: 61

How to replace text in Footers while toggling Footer.Visible?

I have VBA code which replaces the value of the footer.text with "" and turns off footer visibility by Footer.Visible = msoFalse

Every time I set Footer.Visible to msoFalse, the footer text that was changed to "" reverts to the original text. (This can be seen while using PowerPoint -> insert -> Header & Footer -> Slide tab -> Footer dialogue box.)

The entry before changing the footer.text to "" returns.

If I do not change the visibility with Footer.visible=msoFalse, the change to the "" value is accepted.

'This will select the file/folder
Function select_folder()

    Dim Filepicker As FileDialog
    Dim mypath As String

    Set Filepicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    With Filepicker
        .Title = "Select folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        .ButtonName = "Select(&S)"
        If .Show = -1 Then
            mypath = .SelectedItems(1) & "\"
        Else
            End
        End If
    End With

    'Workbooks.Open fileName:=mypath

NextCode:
    select_folder = mypath
    Set Filepicker = Nothing
    
End Function


Sub ppt_delete()

Dim strInFold As String, strFile As String, PrsSrc As PowerPoint.Presentation
Dim extension As String
Dim PPApp As PowerPoint.Application
Dim PPSlide As PowerPoint.Slide

strInFold = select_folder
extension = "*.ppt*"
    
strFile = Dir(strInFold & extension)
    
Do While strFile <> ""

    ' 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

    DoEvents
    Set PrsSrc = PPApp.Presentations.Open(Filename:=strInFold & strFile)

    For Each PPSlide In PrsSrc.Slides

        PPSlide.HeadersFooters.Footer.Visible = msoTrue
        PPSlide.HeadersFooters.Footer.Text = ""
    
        'PPSlide.HeadersFooters.Footer.Visible = msoFalse
        'you can comment and uncomment above line to test

        DoEvents

    Next PPSlide

    PPApp.ActivePresentation.Save
    PPApp.ActivePresentation.Close

    strFile = Dir

Loop

PPApp.Quit

End Sub

Additional info. The script will first choose a folder where the .ppt* files are located. Script will check all the .ppt extensions in the folder, and make the changes.

How can I do this:

PPSlide.HeadersFooters.Footer.Visible = msoTrue
PPSlide.HeadersFooters.Footer.Text = ""
PPSlide.HeadersFooters.Footer.Visible = msoFalse

and make the changes to "" visible in powerpoint -> insert-> Header & Footer -> Slide tab -> Footer dialogue box.

Upvotes: 0

Views: 336

Answers (2)

Steve Rindsberg
Steve Rindsberg

Reputation: 14810

Another approach: Tag the parent slide with the text you want to apply, then when you want to make the hidden footer visible again, set it to the saved text in the tag. Advantage is that this is near instant, where saving and reopening could take quite a while if the presentation is large.

Sub Test()
    Dim osl As Slide
    For Each osl In ActivePresentation.Slides
        With osl.HeadersFooters.Footer
            
            .Text = "New Text"
            SetText osl, "TEXT", .Text
            .Visible = False
            .Visible = True
            .Text = GetText(osl, "TEXT")
        End With
    Next
End Sub

Function GetText(osl, sTagname As String)
    GetText = osl.Tags(sTagname)
End Function

Function SetText(osl As Slide, sTagname As String, sText As String)
    osl.Tags.Add sTagname, sText
End Function

Upvotes: 0

bujom
bujom

Reputation: 61

Apparently, the footer value is hidden in the presentation. this is the reason why it always comes back.

The solution was to assign the footer.text to "" save and close, reopen the ppt, then switch to PPSlide.HeadersFooters.Footer.Visible = msoFalse

Upvotes: 1

Related Questions