Fusszeile erneuern - Im Master bleibt alte Fusszeile drinnen

[dp9]

Hi ihr lieben VBA-Programmierer

Mit fremder Hilfe habe ich ein Makro erstellt, das in allen PPTs, die in einem Ordner sind, die Datei-Eigenschaften und zeitgleich die Fusszeile erneuert. Das klappt bestens. Leider habe ich erst heute festgestellt, dass die Fusszeile in der Masteransicht noch die alte bleibt. Im Menü Fusszeile/Kopfzeile einfügen steht jeweils korrekt die neue Fusszeile - leider im Master nicht ... angezeigt wird in einer bearbeiteten PPT in der normalen Ansicht die korrekte und neue Fusszeile. Ich habe keine Ahnung wo der Fehler liegen könnte oder was man ergänzen müsste ...

Weiss jemand einen Rat?

Besten Dank für allfällige Tipps.

VERSION: Office 2019

Hier der Code:

Code:

Sub SetDocPropsPlusFootereintragen()

Dim dd1 As Presentation
Dim dokupfad As String, endung As String, dateiname As String
Dim s As Slide
Dim p As Slide

dokupfad = "C:\Users\..."                    '**der Pfad, in dem die zu bearbeitenden Dokumente liegen anpassen!
endung = "*.pptx"                            '**Anpassen, falls nötig!
dateiname = Dir(dokupfad & endung)

'**********Beginn der Schleife durch alle Dateien im Ordner ***************

   Do While dateiname <> ""
        Set dd1 = Presentations.Open(FileName:=dokupfad & dateiname)           'öffnet das Dokument
        
            '********************* Zu wiederholende "Arbeit"*******************************************************
        
         If Presentations.Count > 0 Then
        
          '********** Alle Eigenschaften des Files werden gelöscht "***********
            
                        Dim oProp As DocumentProperty
                On Error Resume Next
                For Each oProp In ActiveDocument.BuiltInDocumentProperties
                    oProp.Value = ""   'entsprechende Eigenschaft wird gelöscht
                Next oProp
            
            '********** Alle Eigenschaften des Files werden NEU gesetzt "***********
            
            Dim dp As Object
            Set dp = ActivePresentation.BuiltInDocumentProperties
            dp("Title") = "NAME XYZ"
            dp("Subject") = "NAME XYZ"
            dp("Keywords") = "NAME XYZ"
            dp("Category") = "NAME XYZ"
            dp("Comments") = "NAME XYZ"
            dp("Author") = "NAME XYZ"
            dp("Company") = "NAME XYZ"
            dp("Manager") = "NAME XYZ"
          End If
    
        For Each s In ActivePresentation.Slides
            s.HeadersFooters.Footer.Visible = msoTrue                   'Footer soll erst sichtbar werden
            s.HeadersFooters.SlideNumber.Visible = msoTrue              'Foliennummer sichtbar machen
            s.HeadersFooters.Footer.Text = " NEUER NAME XYZ"            'Footer mit Text füllen
                      
        Next s
    
    
        ActivePresentation.SlideMaster.HeadersFooters.DisplayOnTitleSlide = msoFalse
    
        For Each p In ActivePresentation.Slides                                             'Footer gets visible
            If p.CustomLayout.Index <> 1 Then
                p.HeadersFooters.Footer.Visible = msoTrue
                p.HeadersFooters.SlideNumber.Visible = msoTrue                              'Slidenumber gets visible
                p.HeadersFooters.Footer.Text = "NEUER NAME XYZ"                            'Footer gets filled with text
            End If
        Next p
        
      For Each p In ActivePresentation.Slides                                               'Footer Titlesloide gets invisible
            If p.CustomLayout.Index = 1 Then
                p.HeadersFooters.Footer.Visible = msoFalse
                p.HeadersFooters.SlideNumber.Visible = msoFalse                             'Slidenumber gets invisible
            
            End If
        Next p
        
         'Dokument speichern
        dd1.Save

        'Dateien schliessen
        dd1.Close

        Set dd1 = Nothing


     '********************Fortsetzung der Schleife durch alle Dokumente********************

        dateiname = Dir ' nächste Datei
  
    Loop
    
End Sub

SIEHE AUCH:

http://www.office-loesung.de/p/viewtopic...1#p3277241

http://www.vba-forum.de/Forum/View.aspx?...le_drinnen

[Jackben67]

Ne so ganz speziell kann ich dir da jetzt auch nicht helfen. Hoffe, dass du schnell eine Antwort bekommst.