Word'de Yazdırdığım Kriterleri Sayma ve MsgBox'da Gösterme

[baysevimli]

Arkadaşlar Merhaba,

Aşağıdaki kod ile word dosyamda olan onlarca, yüzlerce metnime otomatik karar no ve teklif no yazdırıp sıralatıyorum. kod çalışıyor şuan. istediğim şu; kaçtane teklife sıra numarası verdi ve kaç tane teklife karar no verdi. bunu bana işlemi bitirince msgbox ile göstersin. bunun amacı ise herhangi bir karar no veya teklif noyu atladımı anlamak.

Sub Makro1()
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
Next


ActiveDocument.Select
ab = Split(Selection, ".TEKL" & ChrW(&H130) & "F")
say = UBound(ab)
Selection.HomeKey unit:=wdStory
For i = 1 To say
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
Next


End Sub

 

[necati]

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
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
Next

MsgBox "İşlem Tamam" & vbCrLf & say & " adet KARAR NO:" & vbCrLf & _
say2 & " adet TEKLİF verildi"
End Sub

 

[baysevimli]

Necati bey ilginiz için çok teşekkür ederim.

Ancak şöyle bişey var. Teklif sayısını doğru yazıyor. Ama kaç tane karar verdiğini yanlış yazıyor. Ben karar sayarken şunu istiyorum kaç tane karar no ya yazarsa adedini versin. Mesela 136 teklif var 136 tane de karar no olmalı. Fakat ilk kararım benim hep 1 ile başlamıyor. Bazen 200 ile başlıyor ve her tekşife 201,202,203... Diye karar no veriyor. İşte kaçtanesine verdi onu saydırmak istiyorum

 

[necati]

Aslında makro içinde bazı tutarsızlıklar var. Ama siz bu haliyle normal kullanıyorsunuz galiba.
Mesela "TEKLİF" bulma işlemi yaparken her seferinde bir atlıyor sonrakine işlem yapıyor. Bunu farkettiniz mi?
Eğer problem değilse basitçe şunu yapın:

Birinci "Next" satırı üzerine

x = x + 1
Next

İkinci "Next" satırı üzerine

y = y + 1
Next

Yazdıktan sonra "mesajbox" satırını da:

MsgBox "İşlem tamam" & vbCrLf & x & " adet KARAR NO:" & vbCrLf & _
y & " adet TEKLİF verildi"

Yapın tamamdır.

 

[baysevimli]

evet ondan haberim var istediğim bişey o. bu arada son yazdığınız kodlar tam istediğim gibi. çok sağolun. Allah razı olsun.

 

[necati]

Amin. Sizler de sağolasınız.