Word 2003 te VBA ile Paragraf Seçme ve Bul Değiştir İşlemleri
Merhaba, bu örneğimizde işler yolunda giderse sizlere başlıkta da belirttiğim üzere paragraf ya da aralılk (range sınıfı kullanarak) seçme işlemini ve bu seçim üzerinde arama yapma ve duruma göre bulunan metni bir diğer metin ile değiştirme işlemini anlatmaya çalışacağım. Hemen işe koyulalım.
Öncelikle kendinize yeni bir dosya açarak gerekli makro güvenlik düzeyi ayarlarını yapınız. Kodları biz yazdığımıza ve kendi sistemimize düşman olmadığımıza göre biz çalışırken word' un tüm kodlarımızı çalıştırmasının bir zararı olmayacaktır. Aman dikkat işiniz bittikten sonra güvenlik ayarlarını yeniden eski değerlerine getirin. Diğerleri pek de insaflı olmayabilir...Her neyse, sonrasında belgenize Visual Basic Araç çubuğunu kullanarak 4 adet düğme (CommandButton), 2 adet açılır kutu (Combobox) ve 2 adet metin kutusu (TextBox) ekleyerek bu nesnelerin özelliklerini Şekil-1 dekigibi ayarlayınız. Şayet nesnelerin name özelliklerini kendi istediğiniz gibi vermek istiyorsanız bu durumda her düğmenin kodunu kendi nesnenizin onClick() olayına yapıştırmayı unutmayın. Yani buradaki kodları olduğu gibi almayın.
Şekil-1
Daha sonra belgenizde üzerine çizim araç çubuğunuz kullanarak bir adet metin kutusu ekleyin. Sakın karıştırmayın daha önce ekledikleriniz birer ocx nesnesi idi bu ise temelde bir shape (şekil) nesnesi. Son olarak ta elbette üzerinde işlem yapacağız atık veri ekleme işleminde sıra geldi. Bunu da daha önce izah ettiğimiz =rand() yöntemi ile çözüyoruz. Evet tasarım böylece sona ermiş oldu şimdi sıra geldi kodlara. Aşağıdaki kodlarda yeralan kutulariIndeksle() alt programını bir defaya mahsus çalıştırırsanız. Belgenize eklendiğiniz metin kutusunun indeksini öğrenebilirsiniz. Şimdi bu ne kadar önemli diyecek olursanız; belgeye her eklenen şekil shape sınıfının bir elemanı gibi eklenir ve indekslenir bu bir commandbutton ya da listbox vb. ocx nesnesi olsa bile. Bu nedenle eklenen her bir elemana word tarafından bir indeks numarası verilir. Bu konuyu sizlere daha açık bir şekilde karşılaştırma algoritmasının simulasyonunda daha açık bir şekilde izah edeceğim. Şimdilik siz şunu bilin yeter. Belgeye ne çizerseniz çizin bu shape sınıfının bir elemanı olacaktır. Bu kadar.
Son olarak düzeneğimizin çalışması için ister Visual Basic Araç çubuğu üzerindeki Visual Basic Düzenleyicisi düğmesine basın isterseniz de Alt+F11 tuşlarına basın farketmez, kod görünümüne geçin ve aşağıda verilen kodları yazın. İşlem tamam yine Visual Basic Araç çubuğu üzerindeki tasarım modu butonu ile tasarım modunu kapatarak düğmelerinizi etkinleştirin ve onları test edin. Haydi hayırlı kodlamalar...
Private Sub kutulariIndeksle()
'***********************************************************************************************
'Kodlayan : Bilal SERT
'Tarih/Saat : 25.12.2012 / 10:50
'Amaç : Belgedeki metin kutularinin indekslerini kendilerine
' bir metin olarak yazdirmak.
'Giriş/Çıkış : yok
'***********************************************************************************************
Dim i As Integer
For i = 1 To ThisDocument.Shapes.Count
On Error Resume Next
ThisDocument.Shapes(i).TextFrame.TextRange = i
Next
End Sub
Private Sub bul(deger As String)
'***********************************************************************************************
'Kodlayan : Bilal SERT
'Tarih/Saat : 25.12.2012 / 10:50
'Amaç : Belirli bir aralikta metin bulma işlemi yapmak
'Giriş/Çıkış : deger, aranan metin / yok
'***********************************************************************************************
Dim aralik As Range
'paragraf varsa seç
If ThisDocument.Paragraphs.Count > 0 And ComboBox1.ListCount > 0 Then
Set aralik = ThisDocument.Range(ThisDocument.Paragraphs(ComboBox1.ListIndex + 1).Range.Start, _
ThisDocument.Paragraphs(ComboBox2.ListIndex + 1).Range.End)
aralik.Select
With Selection.Find
'arama yonu
.Forward = True
'false içinde geçen kelimeler true kelimenin sadece kendisini ara demektir.
.MatchWholeWord = False
'Büyük küçük harf duyarlılığı kapalı
.MatchCase = False
.Wrap = wdFindContinue
.Execute FindText:=deger
End With
End If
End Sub
Private Sub btnBulDegistir_Click()
Dim aralik As Range, aranan, yeni As String
'sayet kelimeyi bulmak istiyorsak ***********************************
'bul txtAranan.Text
'*****************************************************************************
'sayet bul-degistir islemi yapmak istiyorsak
If ComboBox1.ListCount > 0 And ComboBox2.ListCount > 0 Then
Set aralik = ThisDocument.Range(ThisDocument.Paragraphs(ComboBox1.ListIndex + 1).Range.Start, _
ThisDocument.Paragraphs(ComboBox2.ListIndex + 1).Range.End)
aralik.Find.Execute FindText:=txtAranan.Text, _
ReplaceWith:=txtYeni.Text, Replace:=wdReplaceAll
End If
End Sub
Private Sub btnCikis_Click()
'1. Acik belgeyi kaydetmeden cik
Application.Quit wdDoNotSaveChanges
'2. Acik belgeyi kaydet ve cik
' Application.Quit wdSaveChanges
End Sub
Private Sub btnIncele_Click()
Dim sayac As Integer
With ThisDocument
.Shapes(1).TextFrame.TextRange = "Bu belgede toplam " & _
Trim(Str(.Paragraphs.Count)) & " adet paragraf bulunmaktadır"
If .Shapes.Count <> 0 Then
ComboBox1.Clear: ComboBox2.Clear
.Shapes(1).TextFrame.TextRange = ""
For sayac = 1 To .Paragraphs.Count
ComboBox1.AddItem "Paragraf-" & Trim(Str(sayac))
ComboBox2.AddItem "Paragraf-" & Trim(Str(sayac))
.Shapes(1).TextFrame.TextRange = .Shapes(1).TextFrame.TextRange & _
Str(Trim(sayac)) & " nolu paragrafta " & _
.Paragraphs(sayac).Range.Words.Count & " adet kelime bulunmaktadır "
Next
ComboBox1.ListIndex = 0
ComboBox2.ListIndex = 0
End If
End With
End Sub
Private Sub btnParagrafSec_Click()
'paragraf varsa seç
With ThisDocument
If .Paragraphs.Count > 0 And ComboBox1.ListCount > 0 Then
' ThisDocument.Paragraphs(ComboBox1.ListIndex + 1).Range.Select
.Range(.Paragraphs(ComboBox1.ListIndex + 1).Range.Start, _
.Paragraphs(ComboBox2.ListIndex + 1).Range.End).Select
End If
End With
End Sub
Yardımcı olması dileğiyle. Güç sizinle olsun...