Word'da Kriter Saydırma

[baysevimli]

Arkadaşlar Merhaba,
Aşağıdaki kod dizinleri ile Word dokümanımda bazı yerlere otomatik sayı verdiriyorum. Şuan işimi görüyor bu kodlar. Kod dizininin altında ise dikkat ettiyseniz Word dokümanımda kaç tane “.TEKLF” ve “KARAR NO:” varsa saydırıp ve msgbox da göster diyorum. Şimdi istediğim şu; msgbox da bunlara ilave olarak dokümanda kaçta ne “İcra” , “Yönetim” , “Denetim” ve “Hukuk” ibareleri varsa saysın onların adedini de msgbox da göstersin istiyorum. İlginiz için teşekkür ederim.

 

[Haluk]

Mesajın ekinde ne Word dosyası var, ne de kod ...

.

 

[baysevimli]

çok özür dilerim unutmuşum. kod aşağıdaki gibidir.

Sub Makro1()
'baysevimli
Dim InitialDecisionNo As Integer
Dim InitialDecisionStr As String

InitialDecisionNo = 1

ActiveDocument.Select
Selection.HomeKey unit:=wdStory

Selection.Find.Text = "KARAR NO:"
Selection.Find.Execute
With Selection
.Collapse Direction:=wdColl
.ColumnSelectMode = True
.MoveLeft unit:=wdWord, Count:=-2, Extend:=wdExtend
.ColumnSelectMode = False
End With


InitialDecisionStr = Replace(Selection.Range.Text, " ", "")

If Not InitialDecisionStr = "" Then
InitialDecisionNo = CInt(Selection.Range.Text)
End If


ActiveDocument.Select
ab = Split(Selection, "KARAR NO:")
say = UBound(ab) + (InitialDecisionNo - 1)
Selection.HomeKey unit:=wdStory

For i = InitialDecisionNo To say
Selection.Find.Text = "KARAR NO:"
Selection.Find.Execute
With Selection
.Collapse Direction:=wdColl
.ColumnSelectMode = True
.MoveLeft unit:=wdWord, Count:=-2, Extend:=wdExtend
.ColumnSelectMode = False
End With
Selection.Range.Text = i & vbTab
Selection.Find.Execute
x = x + 1
Next


ActiveDocument.Select
ab = Split(Selection, ".TEKL" & ChrW(&H130) & "F")
say2 = UBound(ab)
Selection.HomeKey unit:=wdStory
For i = 1 To say2
Selection.Find.Text = ".TEKL" & ChrW(&H130) & "F"
Selection.Find.Execute
With Selection
.Collapse Direction:=wdCollapseStart
.ColumnSelectMode = True
.MoveRight unit:=wdWord, Count:=-1, Extend:=wdExtend
.ColumnSelectMode = False
End With
Selection.Range.Text = i
Selection.Find.Execute
y = y + 1
Next

MsgBox "Merhaba ! Bitti." & vbCrLf & x & " adet Karar No" & vbCrLf & _
y & " adet Teklif No "
End Sub