Fußzeilen ersetzen per Makro

Computer: Software & Programmierung Visual Basic
#1

Hallo,

ich möchte gerne ein Makro erstellen, welches alle dot Dateien in einem Verzeichnis öffnen und überprüft ob eine Fußzeile vorhanden ist.
Wenn Ja, soll das Makro die Fußzeile mit dem befüllen was im Zwischenspeicher ist.
(Alternativ wäre es super, wenn ich einen Fußzeilenbaustein dort einbauen könnte, den ich selber erstellt habe, aber irgendwie funktioniert das nicht so wie ich mir vorgestellt habe. Deshalb denke ich aus dem Zwischenspeicher einfügen ist einfacher.)
Am Ende soll die Datein geschlossen und gespeichert werden.
Ich habe nun soweit einen Code herausgesucht, der das umsetzen könnte, was ich vorhabe. Vorher war der Code für finden & ersetzen gedacht.

Code:
Dim anzdatei As Integer
Dim Pfad As String
Dim Datei As String
Dim Schutz As Boolean
Dim i As Long
Dim a As Long
Dim fs As New Collection

Schutz = False

Pfad = InputBox(„Geben Sie den Pfad an“, „Pfad“)

If Right(Pfad, 1) „“ Then Pfad = Pfad & „“

Datei = Dir(Pfad, vbDirectory)
If Datei = „“ Then
MsgBox „kein Ordner oder Dateien!“
Exit Sub
End If

Do While Datei „“
If Datei „.“ And Datei „…“ Then
If (GetAttr(Pfad & Datei) And vbDirectory) vbDirectory Then
If Right(Datei, 4) = „dotm“ Or Right(Datei, 4) = „dotx“ Then
fs.Add Pfad & Datei
End If
End If
End If
Datei = Dir
Loop

anzdatei = fs.Count

For i = 1 To anzdatei
WordBasic.DisableAutoMacros 1
Documents.Open fs(i)

If ActiveDocument.ProtectionType wdNoProtection Then
Schutz = True
'Array für den Dokumentenschutz der Abschnitte
ReDim strArray(ActiveDocument.Sections.Count)

'Array einlesen
For a = 1 To ActiveDocument.Sections.Count
If ActiveDocument.Sections(a).ProtectedForForms = True Then
strArray(a) = 1
Else
strArray(a) = 0
End If
Next
'Dokumentenschutz aufheben
ActiveDocument.Unprotect
End If

'hier wird Test in den Dokumenten gesucht und geändert
Dim MyStoryRange As Word.Range
For Each MyStoryRange In ActiveDocument.StoryRanges
With MyStoryRange.Find
.ClearFormatting
.Text = „Ursprungstext“

With .Replacement
Selection.WholeStory
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End With

.Execute Replace:=wdReplaceAll, _
Format:=True, MatchCase:=True, _
MatchWholeWord:=True

End With

Next MyStoryRange

If Schutz = True Then
For a = 1 To ActiveDocument.Sections.Count
If strArray(a) = 1 Then
ActiveDocument.Sections(a).ProtectedForForms = True
Else
ActiveDocument.Sections(a).ProtectedForForms = False
End If
Next
'Dokumentenschutz wieder einschalten
ActiveDocument.Protect Password:="", NoReset:=True, Type:=wdAllowOnlyFormFields
End If

'Dokument wird gespeichert und geschlossen
ActiveDocument.Save
ActiveDocument.Close
WordBasic.DisableAutoMacros 0

Next i

MsgBox „Es wurden " & anzdatei & " Datei(en) neu gespeichert!“

End Sub

Nun zu meinem Part, hier soll dann die Fußzeile gewählte, alles markiert und durch den Fuß im Zwischenspeicher ersetzt werden.

Code:
ActiveWindow.View.SeekView = wdSeekCurrentPageFooter
Selection.WholeStory
Selection.PasteAndFormat (wdFormatOriginalFormatting)

Mein Problem ist jetzt, dass ich nicht weiß, wie ich meinen Teil und den anderen Teil zusammenbringen kann. Außerdem möchte ich, dass das Makro nachschaut ob eine Fußzeile vorhanden ist, wenn nicht, soll auch nichts überschrieben werden.

Hat jemand da eine Idee? Ich bin leider nicht ganz so gut im Programmieren, verzeiht mir deshalb, falls ich jetzt den total falschen weg gegangen bin.

Falls jemand eine Idee hat, würde ich mich über eine Antwort freuen!

Gruß enny1086

#2

Bin leider schon so gut wie im Urlaub.
Leider hast du eine Menge Code eingestellt und der ist noch nicht mal strukturiert, da fällt das Durchsehen schwer und dauert zu lange.

Daher von mir keine Tipps.
Sorry

#3

Hallo enny86,
word ist eigentlich nicht meins… Da Du hier schon einiges an Code zusammengetragen hast, kann es mit nicht so gut nicht so weit her sein.
Einzelteile ansprechen? Keine Ahnung. Gibt der Makrorekorder nix her?
Wie Du prüfen kannst, ob in der Fußzeile was drin ist, findest Du hier:
http://www.ms-office-forum.net/forum/showthread.php?..
Viel Erfolg auf der weiteren Suche.
MfG MwieMichel

#4

Hi,

ich habe das Gefühl, als hätte ich Dir schon einmal auf die gleiche Frage geantwortet.
3 Dinge: 1. Das vorgestellte Makro - warum nimmst Du eigentlich nicht die Pre-Tags? - ist vollkommen überdimensioniert. 2. Man arbeitet mit Ranges, nicht mit Selection. 3. Fußzeilen sind immer vorhanden.

In der Antwort, an die ich mich erinnere, habe ich nahegelegt, auf VBA zu verzichten. Das Abfangen möglicher Fehler ist so aufwendig, daß man schneller manuell geändert hat.
Um dem Einwand vorzubeugen, daß das Ändern der Fußzeilen regelmäßig erfolgen und daher per VBA erledigt werden muß: Word stellt über Felder, Dokumenteigenschaften und AutoMakros derart viele Möglichkeiten zur Verfügung, eine im doppelten Sinne lebende Fußzeile zu erzeugen, daß überhaupt keine Notwendigkeit für nachträgliche Änderungen per VBA besteht. Es reicht vollständig aus, die Dokumentvorlagen sauber (insbesondere ohne Redundanz) aufzubauen.
Mach es besser manuell. Wenn Du pro Tag fünf Dots änderst, hast Du in zwei Wochen (= zehn Arbeitstage) fünfzig Dots verändert. Wenn Du mehr hast, stimmt auch Dein Vorlagenkonzept nicht. Dann solltest Du einen wirklichen Profi dranlassen.

HTH.

Markus

#5

Hallo enny86,

Hier mal ein objektorientierter Ansatz:

Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSection As Word.Section
Dim strDirectory As String
Dim strFile As String

strDirectory = „LW:\Verz*.dot“ 'Hier das Verzeichnis mit Dot-Dateien eintragen

strFile = Dir(strDirectory, vbNormal)

Set objWord = CreateObject(„Word.Application“) 'Word öffnen
objWord.Application.Visible = False 'Word ausblenden

While strFile „“
Set objDoc = objWord.Documents.Add(strFile)

For Each objSection In objDoc
If objSection.Footers.Count > 0 Then
objSection.Footers(wdHeaderFooterPrimary).Range.Text = „Hier der neue Text“
End If
Next objSection
objDoc.Save 'Vorher Sicherheitskopie anlegen!
objDoc.Close
Set objDoc = Nothing

strFile = Dir
Wend

objWord.Quit
Set objWord = Nothing
End Sub

Hoffe, das hilft.

Gruß
Harry