Dateien nach Kundennummer zerpflücken

07/09/2009 - 09:33 von Oliver | Report spam
Word-Version XP


Hallo zusammen,

ich habe nachfolgendes Makro einmal aufgezeichnet, damit klar wird, was ich
machen will.
Ich habe eine Word-Datei, in der die Rechnungen von Kunden alle
untereinander stehen. Nun soll jeweils eine Rechnung eines Kunden einzeln
abgespeichert werde.
Ich hatte mir das wie in dem Makro zu sehen so vorgestellt, dass jeweils am
Ende eines Kunden das Wort XXX_ENDE steht. Danach suche ich , lösche diesen
Kenner und markiere dann alles bis zum Dokumentanfang.
Das markierte wird ausgeschnitten und in ein neues Dokument eingefügt.
Dann soll aus der ersten Zeile die 9-stellige Kundennummer kopiert werden
und das neue Dokument unter dieser Kundennummer abgespeichert werden.
Jetzt wird das soeben gespeicherte Dokument geschlossen und aus der
Gesamtdatei wird durch 2x Zeile löschen eine Leerzeile und ein Seitenumbruch
gelöscht.

=> Dann für die nàchste Kundennummer.

Ich habe das mal für 5 Kundenrechnungen manuell gemacht - funktioniert für
mich zufriedenstellend.

=> nun müsste jedoch die Kundennummer wirklich kopiert und als Dateiname
übergeben werden und das Makro sollte endlos bis zum Ende der Datei laufen,
was aktuell nicht der Fall ist.

Ich bin für jede Hilfe dankbar, ich krieg das leider nicht alleine hin.

Vielen Dank



#######################################
Makro:

Attribute VB_Name = "NewMacros"
Sub Makro()
Attribute Makro.VB_Description = "Makro aufgezeichnet am 05.09.2009 von
ogross"
Attribute Makro.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Makro"
'
' Makro Makro
' Makro aufgezeichnet am 05.09.2009 von ogross
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "XXX_ENDE"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
ChangeFileOpenDirectory _
"C:\Dokumente und Einstellungen\ogross\Desktop\zerpflücken\"
ActiveDocument.SaveAs FileName:="111111111.doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
ActiveWindow.Close
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "XXX_ENDE"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
Documents.Add DocumentType:=wdNewBlankDocument
ActiveWindow.Close
Selection.Copy
ChangeFileOpenDirectory _
"C:\Dokumente und Einstellungen\ogross\Desktop\zerpflücken\"
ActiveDocument.SaveAs FileName:="222222222.doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
ActiveWindow.Close
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "XXX_ENDE"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
ChangeFileOpenDirectory _
"C:\Dokumente und Einstellungen\ogross\Desktop\zerpflücken\"
ActiveDocument.SaveAs FileName:="333333333.doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
ActiveWindow.Close
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "XXX_ENDE"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
ChangeFileOpenDirectory _
"C:\Dokumente und Einstellungen\ogross\Desktop\zerpflücken\"
ActiveDocument.SaveAs FileName:="444444444.doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
ActiveWindow.Close
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "XXX_ENDE"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Copy
ChangeFileOpenDirectory _
"C:\Dokumente und Einstellungen\ogross\Desktop\zerpflücken\"
ActiveDocument.SaveAs FileName:="555555555.doc", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="",
AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False,
EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
ActiveWindow.Close
End Sub
 

Lesen sie die antworten

#1 Bernhard Sander
07/09/2009 - 13:40 | Warnen spam
Hallo Oliver,

Dann soll aus der ersten Zeile die 9-stellige Kundennummer kopiert werden
und das neue Dokument unter dieser Kundennummer abgespeichert werden.


Bekommt bei Euch jeder Kunde nur eine einzige Rechnung? Falls der gleiche Kunde
mehrere Rechnungen bekommen hat, wird bei Deinem Speicherkonzept nur die letzte
Rechnung gespeichert und frühere Rechnungen werden immer wieder überschrieben.
Da muss vermutlich ein anderes Speicherschema her.

=> nun müsste jedoch die Kundennummer wirklich kopiert und als Dateiname
übergeben werden und das Makro sollte endlos bis zum Ende der Datei laufen,
was aktuell nicht der Fall ist.


Sollt nicht so sonderlich schwierig sein, solange die Stelle, an der die
Kundennummer steht, sicher zu ermitteln ist. Ermittle die Stelle mit Hilfe eines
Range-Objekts, z.B. so:

...
Set KdNr = Selection.Range
KdNr.Move Unit:=wdCharacter, Count:
' Als Count die Anzahl von Zeichen angeben, die vor der Nummer im Text stehen
KdNr.MoveEnd Undit:=wdCharacter, Count := 9
' Als Count die Anzahl von Zeichen aus denen die Nummer besteht
Dateiname = KdNr.Text + ".doc"
...
ActiveDocument.SaveAs FileName:=Dateiname, FileFormat:= _
...

Dann reduzierst Du Dein Makro noch auf die Zeilen für einen Speichervorgang und
machst eine geeignete Schleife drumrum.

Gruß
Bernhard Sander

Ähnliche fragen