Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
PPT Fusszeile erneuern - Im Master bleibt alte Fusszeile drinnen |
09.02.2020 18:09:38 |
p9 |
|
|
|
10.02.2020 09:37:45 |
Gast2348 |
|
|
Von:
p9 |
Datum:
09.02.2020 18:09:38 |
Views:
1491 |
Rating:
|
Antwort:
|
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:
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
|
- 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
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- 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
|
PPT Fusszeile erneuern - Im Master bleibt alte Fusszeile drinnen |
09.02.2020 18:09:38 |
p9 |
|
|
|
10.02.2020 09:37:45 |
Gast2348 |
|
|