PDA

Vollständige Version anzeigen : Durchsuchen welche DOT Vorlagen eine Grafik haben


r.zschammer
14.07.2009, 08:34
Hallo zusammen,

ich habe ~ 250 DOT Vorlagen die ich durchsuchen muss ob sie eine Grafik mit einer Unterschrift haben um diese dann zu ersetzen.

Gibt es eine Möglichkeit dies mit VBA zu realisiern? Das alle DOT Vorlagen die ich in einem separaten Ordner habe zu durchsuchen und mir danach die Dateinamen in einer Liste zur Verfügung zu stellen.

Das würde meine Arbeit um einiges Verkürzen.

Danke für euere Hilfe

Gruß

Ralf

r.zschammer
15.07.2009, 10:03
Hallo,

ich habe schon einen Code wo ich die Fußzeile ändern kann. Dieser Code müsste angepast werden damit eine Überprüfung durchgeführt werden kann welche Dokumente eine Grafik beinhalten.

Ich denke das an der Stelle wo ich die Zeilen mit einem Fettdruck versehen habe müsste die Änderung durchgeführt werden.

Sub Vorlagen_Fußzeile_ersetzen()

Dim anzdatei As Integer
Dim pfad As String
Dim Schutz As Boolean
Dim i As Long
Dim a As Long
Dim fs As FileSearch
Dim myFooter As HeaderFooter


Schutz = False
Set fs = Application.FileSearch

pfad = InputBox("Geben Sie den Pfad an", "Pfad")

With fs
.NewSearch
.FileType = msoFileTypeTemplates
.LookIn = pfad
If .Execute = 0 Then
MsgBox "Es wurden keine Dateien gefunden."
Exit Sub
Else
anzdatei = .FoundFiles.Count
End If
End With

For i = 1 To anzdatei
WordBasic.DisableAutoMacros 1
Documents.Open fs.FoundFiles(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



'ab hier wird die Fußzeile in den Documenten gesucht und geändert



Set myFooter = ActiveDocument.Sections(ActiveDocument.Sections.Count).Footers(wdHeaderFooterPri mary)
If Len(myFooter.Range.Text) > 1 Then
myFooter.Range.Paste
End If

'ab hier wird der Schutz wieder gesetzt

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

Dieser Code wurde mir von Hotte zur Verfügung gestellt.

Danke für euere Hilfe

Gruß

Ralf