Word και αλλαγή λέξεων με VBA

[Pleasure]

Συνάδελφοι συνπρογραμματισταί

 

Έχω ένα μικρό προβληματάκι. Ας υποθέσουμε πως έχουμε ένα σετ από αρχεία Word, και μέσα στο κείμενό τους έχουν πχ κάπου γραμμένη μια ημερομηνία συγκεκριμένη.

 

Υπάρχει η δυνατότητα με Visual Basic να ανοίξω το έγγραφο αυτό και με κώδικα να αφαιρέσω τη συγκεκριμένη ημερομηνία με μία νέα που θα δώσω σε μία πχ φόρμα ?

 

Φαντάζομαι πως θα υπάρχει τρόπος όμως η ασχετοσύνη μου δεν μου επιτρέπει να τον ξέρω.

 

Ευχαριστώ για τον χρόνο σας ...

[alkisg]

Δεν έχω το χρόνο να σου γράψω ολόκληρο τον κώδικα, σου γράφω όμως μερικά κομματάκια του για να ψάξεις στο google ή στη βοήθεια για τα υπόλοιπα:

>  Dim apWord As Word.Application
 Set apWord = CreateObject("Word.Application")
 Call apWord.Documents.Open("C:\...\ταδε.doc", , True)
 apWord.Visible = True

Τον κώδικα για την αλλαγή της ημερομηνίας μπορείς να τον κατασκευάσεις αν φτιάξεις μια μακροεντολή και δεις τι κώδικα έβγαλε...

[Pleasure]

Σε ευχαριστώ για την απάντηση. Μέχρι εδώ όλα καλά πάνε. Από εκεί και πέρα είναι το πρόβλημα.

[Pleasure]

EDITED: Να βρίσκει και στα Headers - Footers

 

Λοιπόν αδέρφια το βρήκα

 

Έστω πως έχετε ένα αρχείο Word στο C:\ με όνομα Leventis.doc

 

Μέσα στο αρχείο βάζετε το εξής [XXXXX] μαζί με τις αγκύλες. Εϊναι το σημείο που θέλετε να μπει το κείμενο. Στη συνέχεια :

 

Public APWORD As Word.Application

Public Doc As Document

Private Sub Command2_Click()

 

Set APWORD = New Word.Application

APWORD.Visible = False

Set Doc = APWORD.Documents.Open("C:\leventis.doc")

Doc.Select

On Error GoTo ErrorOcurred

 

With APWORD.Selection.Find

.Text = "[" & Trim("XXXXX") & "]"

.Replacement.Text = Trim("ΓΕΙΑ ΣΟΥ ΦΙΛΕ")

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = True

.MatchWholeWord = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

APWORD.Selection.Find.Execute Replace:=wdReplaceAll

 

Dim HeaderFooter As Word.Range

For Each HeaderFooter In APWORD.ActiveDocument.StoryRanges

With HeaderFooter.Find

.Text = "[" & Trim("XXXXX") & "]"

.Replacement.Text = Trim("ΓΕΙΑ ΣΟΥ ΦΙΛΕ")

.Wrap = wdFindContinue

.Format = False

.Forward = True

.MatchCase = True

.MatchWholeWord = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

HeaderFooter.Find.Execute Replace:=wdReplaceAll

Next

 

 

Doc.SaveAs ("c:\leventisnew.doc")

Doc.Close False

 

ErrorOcurred:

Success:

End Sub

 

 

 

 

 

Έτσι τα [XXXXX] αντικαρίστανται με το ΓΕΙΑ ΣΟΥ ΦΙΛΕ σε ένα νέο αρχείο Word με το όνομα leventisnew.doc. Μην ξεχάσετε να βάλετε στα References to Microsoft Word

[alkisg]

Τα headers/footers δε βρίσκονται μέσα στο κείμενο, είναι κομμάτι των sections, π.χ.

apWord.ActiveDocument.Sections.First.Headers ...

[Pleasure]

Ωραία αλλά τώρα πως θα το κάνω? Μήπως έχεις καμια ιδέα ?

 

Στη συνέχεια του κώδικα και πριν το Doc.saveas τοποθέτησα το εξής:

 

Dim HeaderFooter As Word.Range

For Each HeaderFooter In APWORD.ActiveDocument.StoryRanges

With HeaderFooter.Find

.Text = "[" & Trim("XXXXX") & "]"

.Replacement.Text = Trim("ΓΕΙΑ ΣΟΥ ΦΙΛΕ")

.Wrap = wdFindContinue

.Format = False

.Forward = True

.MatchCase = True

.MatchWholeWord = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

APWORD.Selection.Find.Execute Replace:=wdReplaceAll

End With

Next

 

Το κακό είναι πως δεν δουλεύει αλλά ούτε και χτυπάει Error. Βλέπεις τίποτε λάθος σε αυτό τον κώδικα ?

[Pleasure]

Το βρήκα και το διορθώνω :

 

 

Dim HeaderFooter As Word.Range

For Each HeaderFooter In APWORD.ActiveDocument.StoryRanges

With HeaderFooter.Find

.Text = "[" & Trim("XXXXX") & "]"

.Replacement.Text = Trim("ΓΕΙΑ ΣΟΥ ΡΕ ΦΙΛΕ")

.Wrap = wdFindContinue

.Format = False

.Forward = True

.MatchCase = True

.MatchWholeWord = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

End With

HeaderFooter.Find.Execute Replace:=wdReplaceAll

Next