Thema Datum  Von Nutzer Rating
Antwort
Rot PPT Fusszeile erneuern - Im Master bleibt alte Fusszeile drinnen
 09.02.2020 18:09:38 p9
NotSolved
10.02.2020 09:37:45 Gast2348
NotSolved

Ansicht des Beitrags:
Von:
p9		 Datum:
09.02.2020 18:09:38		 Views:
1621		 Rating:
     
Antwort:
  Ja
Thema:
PPT Fusszeile erneuern - Im Master bleibt alte Fusszeile drinnen

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.

Weiss jemand einen Rat?

Besten Dank für allfällige Tipps.

Hier der Code:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
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

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot PPT Fusszeile erneuern - Im Master bleibt alte Fusszeile drinnen
 09.02.2020 18:09:38 p9
NotSolved
10.02.2020 09:37:45 Gast2348
NotSolved