Koppelen macro's met IF en AND THEN in Word

[Thijs Zuidland]

Ik heb een vraag over het koppelen van 2 na elkaar draaiende macro's.
De eerste macro draait over een journaal en zoekt naar namen.
Als hij er een gevonden heeft kleurt hij deze geel.
Daarna draait hij nogmaals en zoekt naar geboortedata. Bij het vinden wordt deze ook gekleurd.
Om ze naderhand terug te vinden in het document staan er 3 hekjes achter (zoeken met Ctrl F)
Echter hij zoekt afzonderlijk en niet samen
Dus niet op IF naam = .... AND geb.datum = ... THEN "kleur" de gegevens die gevonden zijn.

Vraag is kan iemand mij helpen met het koppelen van deze macro's en dat ze alleen met gevonden
combinatie

Vba code:

Sub sZoeknaamleden()
Dim sZoeknaamleden As String
Start:
Documents.Open FileName:="c:\lijst leden.doc"
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "SUBJECT:"
.Forward = True
End With
Selection.Find.Execute
If Selection.Text = "SUBJECT:" Then
GoTo vervolg
Else
GoTo Einde
End If
vervolg:
Selection.TypeBackspace
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
sTrefwoord = Selection.Text

Bewerken:
Selection.HomeKey Unit:=wdStory
Documents.Open FileName:="c:\infodesk1\Journaal.doc"
Options.DefaultHighlightColorIndex = wdYellow
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = sZoeknaamleden
.Replacement.Text = sZoeknaamleden + " (###)"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
GoTo Start
Einde:
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveDocument.SaveAs FileName:="c:\tmp.doc"
ActiveDocument.Close
End Sub

Sub sZoekGeboorteleden()
Dim sZoekGeboorteleden As String
Start:
Documents.Open FileName:="c:\lijst leden.doc"
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "GEB:"
.Forward = True
End With
Selection.Find.Execute
If Selection.Text = "GEB:" Then
GoTo vervolg
Else
GoTo Einde
End If
vervolg:
Selection.TypeBackspace
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
sTrefwoord = Selection.Text

Bewerken:
Selection.HomeKey Unit:=wdStory
Documents.Open FileName:="c:\infodesk1\Journaal.doc"
Options.DefaultHighlightColorIndex = wdYellow
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = sZoekGeboorteleden
.Replacement.Text = sZoekGeboorteleden + "(###)"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
GoTo Start
Einde:
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveDocument.SaveAs FileName:="c:\tmp.doc"
ActiveDocument.Close
End Sub

 

[Haaren101]

sZoeknaamleden + " (###)"

Moet de + niet een & zijn?

Ron

 

[snb]

Zet svp VBA-code tussen code-tags (#)
Geef een macro niet de naam van een ander object of variabele.
Deze macro doet volgens mij hetzelfde als de jouwe:

Sub korter()
  With Documents.Add("c:\lijst leden.doc")
    sq=Split(.Content,vbCr)
    .Close 0
  End With

  With documents.add("c:\infodesk1\Journaal.doc")
    .content=join(filter(filter(split(.content,vbcr),replace(join(filter(sq,"SUBJECT:"),""),"SUBJECT:","")),replace(join(filter(sq,"GEB:"),""),"GEB:","")),"")
    .saveas "C:\tijdelijk.doc"
    .close
  End With
End Sub

 

[Thijs Zuidland]

Beste SNB

Deze optie werkt niet
Ik heb namelijk een dagelijks rapport waar namen in staan, die gecontroleerd worden op namen met geb. data
De lijst met namen staat in de lijst c:\leden lijst.doc
Deze moet in dat rapport worden gecontroleerd en gemarkeerd worden om naderhand na te zoeken.
Vandaar de string met de zoeklijst die verwijst naar een zoekopdracht "subject" en ""geb"
Deze moeten met elkaar overeenkomen om dan te markeren.
De onderstaande optie werkt wel maar de namen en de data komen niet altijd met elkaar overeen.
Dus vaak dubbelzoeken.
Mijn vraag is de combinatie mogelijk

alsvast bedankt voor de onderstaande oplossing, maar werkt niet met mijn rapportage.

 

[snb]

Sub aangepast()
  With Documents.Add("c:\lijst leden.doc")
    sq=Split(.Content,vbCr)
    .Close 0
  End With

  With documents.add("c:\infodesk1\Journaal.doc")
    .content=join(filter(split(.content,vbcr),replace(replace(join(filter(filter(sq,"SUBJECT:"),"GEB:"),""),"SUBJECT:",""),"GEB:","")),"")
    .saveas "C:\tijdelijk.doc"
    .close
  End With
End Sub