|
Guten Morgen liebe Leute,
ich habe hier zwei für sich alleinstehende und gut funktionierende Makros gefunden und wollte fragen ob einer von euch vielleicht ne Idee hat wie man die beiden kombinieren kann. Über Hilfe würde ich mich sehr freuen da es mir die Arbeit sehr erleichtern würde.
Das erste Makro konvertiert alle im per Dialog ausgewählten Ordner befindlichen .doc Dateien in das .docx und das funktioniert sehr schön.
Sub ConvertDocToDocx()
'Updated by ExtendOffice 20181128
Dim xDlg As FileDialog
Dim xFolder As Variant
Dim xFileName As String
Application.ScreenUpdating = False
Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xDlg.Show <> -1 Then Exit Sub
xFolder = xDlg.SelectedItems(1) + "\"
xFileName = Dir(xFolder & "*.doc", vbNormal)
While xFileName <> ""
Documents.Open FileName:=xFolder & xFileName, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.SaveAs xFolder & Replace(xFileName, "doc", "docx"), wdFormatDocumentDefault
ActiveDocument.Close
xFileName = Dir()
Wend
Application.ScreenUpdating = True
End Sub
jetzt kommt Makro nummer zwei das zum suchen und ersetzen von Text gedacht ist und auch super funktioniert jedoch in jeder Datei einzeln aufgerufen werden muss.
Public Sub Alle_Dateien1()
'//deklarationen
Dim strFileName As String
Dim objDocument As Document
'//Errorhandler initialisieren
On Error GoTo err_exit
'//erste Excelmappe suchen - Ordner anpassen !!!
strFileName = Dir$("C:\Users\marin\Downloads\Basti\Datenblätter fertig\Lichtschranken\Deutsch\*.doc", vbNormal)
'//wenn eine Excelmappe gefunden wurde
If strFileName <> "" Then
'//Schleife starten
Do
'//Excelmappe öffnen
Set objDocument = Documents.Open(FileName:=strFileName)
Dim oStory As Range
For Each oStory In objDocument.StoryRanges
oStory.Find.ClearFormatting
oStory.Find.Replacement.ClearFormatting
With oStory.Find
.Text = "Suchtext Hauptbereich"
.Replacement.Text = "Ersatztext Hauptbereich"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oStory.Find.Execute Replace:=wdReplaceAll
'Jetzt haben wir den Hauptbereich abgearbeitet - nun noch der Rest
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
oStory.Find.ClearFormatting
oStory.Find.Replacement.ClearFormatting
With oStory.Find
.Text = "Suchtext Kopf- und Fußzeile"
.Replacement.Text = "Ersatztext Kopf- und Fußzeile"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oStory.Find.Execute Replace:=wdReplaceAll
Wend
Next
'//Excelmappe schließen - ohne zu speichern = False / mit speichern = True
objDocument.Close SaveChanges:=True
'//nächste Excelmappe suchen
strFileName = Dir$
'//wird keine Mappe mehr gefunde Schleife verlassen
Loop Until strFileName = ""
End If
Exit Sub
err_exit:
MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehlermeldung"
End Sub
stört euch bitte nicht daran das die kommentare für excel angelegt sind es sind wie gesagt online gefundene Makros und ich würde Sie nun gerne kombinieren oder vielleicht sagt ihr ja auch das es viel einfacher geht. Ich möchte ungern jede Datei einzeln anfassen müssen.
Ich bin schonmal froh über jede Antwort die mir in dem Bereich vielleicht weiterhelfen kann.
Liebe Grüße Basti
|