Belge üzerindeki harf, kelime ve paragraflara nasıl erişebiliriz?
Merhaba arkadaşlar bu makalemizde sizlere, eğer her şey yolunda giderse belgemizde yer alan harf, kelime ve paragraflara nasıl erişip onları okuyup şayet gerekiyorsa nasıl değiştireceğimizi anlatmaya çalışacağım. Her zaman olduğu gibi Word programını çalıştırıp kendinize boş yeni bir belge oluşturun. Şayet daha önce ayarlamamışsanız Makro güvenlik düzeyini düşük olarak ayarlayın daha sonra Visual Basic araç çubuğunu kulllanarak belgenize aynı satırda olacak şekilde 5 adet CommandButton nesnesi ekleyin ve bu nesnelerin name ve caption özelliklerini aşağıdaki gibi ayarlayın.
1. Düğme name: btnTemizle Caption: TEMIZLE / Türkçe karakterleri temizlemek için
2. Düğme name: btnInceleKelimeler Caption: KELIMELER / Paragraftaki kelimeleri listelemek ve Resimler kelimesini işaretlemek için
3. Düğme name: btnSifrele Caption: SIFRELE / Kelimelerin ASCII kodunu değiştirmek icin
4. Düğme name: btnSifrecoz Caption: SIFRE ÇÖZ / Kelimelerin ASCII kodlarını eski degerlerine dondurmek icin
5. Düğme name: btnCikis Caption: ÇIKIŞ / Kayıt yapmadan Word uygulamasını sonlandırmak icin
Buraya kadar olan kısmı yaptığınızda gerekli VBA nesnelerimizi oluşturmuş olacaksınız. Ancak sistemin işleyebilmesi için sayfamıza bilgi girilmesi gerekiyor. Sizlere daha öncede belirttiğim üzere burada yazdıklarımı çalıştığım lisedeki öğrenci arkadaşlara yaptırıyorum, böyle bir uygulamada sınıfta tüm öğrenci arkadaşlarda aynı sonuçlara ulaşabilmek aynı verilerin eksiksiz olarak yazılması gerekiyor ki bu imkansız bir şey. Bu nedenle atık veri kullanacağız bu amaçla word ün sürpriz yumurtasından yararlanacağız. Peki nedir bu? Size verdiğiniz cümle sayısından oluşan ve yine sizin verdiğiniz sayıda paragrafların bütünüdür. Bunu nasıl yapıyoruz? Şöyle:
Belgemize =rand(paragraf sayisi, cümle sayisi) biçiminde bir ifade giriyoruz yani 3 cümlelik 7 paragraftan oluşan bir yazıya ihtiyacamız varsa =rand(7,3) yazıyor ve giriş/enter tuşuna basıyoruz. Uuups! İşte ihtiyacımız olan atık veri.
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...
'Tanimlanmayan degiskenlerin kullanılmasına izin verme
Option Explicit
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 btnTemizle_Click()
Dim aralik As Range, adet As Long, sayici As Integer, cevap As VbMsgBoxResult
With ThisDocument
' 'paragraf sayısını okuyoruz
If .Paragraphs.Count > 1 Then
For sayici = 2 To .Paragraphs.Count
Set aralik = .Range(.Paragraphs(sayici).Range.Start, .Paragraphs(sayici).Range.End)
'harf sayısını okuyoruz
cevap = MsgBox(Str(sayici) & ". paragrafta toplam " & aralik.Characters.Count & " adet harf vardır" & _
vbCrLf & "Şimdi paragram Türkçe karakterlerinden temizlenecek" & vbCrLf & _
"Devam etmek ister misiniz?", vbQuestion + vbYesNo + vbDefaultButton1, "Dikkat")
If cevap = vbNo Then Exit Sub 'hayır cevabı ile işlem son bulur.
'Aralikta bulunan Türkçe karakterler ingilizce karşılıkları ile değiştiriliyor.
For adet = 1 To aralik.Characters.Count
Select Case aralik.Characters(adet)
Case "ş"
aralik.Characters(adet) = "s"
Case "Ş"
aralik.Characters(adet) = "S"
Case "ç"
aralik.Characters(adet) = "c"
Case "Ç"
aralik.Characters(adet) = "C"
Case "ö"
aralik.Characters(adet) = "o"
Case "Ö"
aralik.Characters(adet) = "O"
Case "ü"
aralik.Characters(adet) = "u"
Case "Ü"
aralik.Characters(adet) = "U"
Case "ğ"
aralik.Characters(adet) = "g"
Case "Ğ"
aralik.Characters(adet) = "G"
Case "ı"
aralik.Characters(adet) = "i"
Case "İ"
aralik.Characters(adet) = "I"
End Select
Next ' adet, harfleri saymak icin
Next ' sayici, paragraflari saymak icin
End If
End With
End Sub
Sub karakterleriGizle(paragrafID As Integer, durum As Boolean)
Dim kod, aralik As Range, adet As Long
With ThisDocument
Set aralik = .Range(.Paragraphs(paragrafID).Range.Start, .Paragraphs(paragrafID).Range.End)
For adet = 1 To aralik.Characters.Count
If durum = True Then
'sifrele
On Error GoTo hata
kod = Asc(aralik.Characters(adet)) - 5
aralik.Characters(adet) = Chr(kod)
Else
'sifre coz
On Error GoTo hata
kod = Asc(aralik.Characters(adet)) + 5
aralik.Characters(adet) = Chr(kod)
End If
Next
Exit Sub
hata:
MsgBox Err.Description, vbOKOnly + vbCritical, "Hata oluştu"
End With
End Sub
Private Sub btnInceleKelimeler_Click()
Dim aralik As Range, adet As Long, cevap As VbMsgBoxResult, sayici As Integer
With ThisDocument
If .Paragraphs.Count > 1 Then
For sayici = 2 To .Paragraphs.Count
Set aralik = .Range(.Paragraphs(sayici).Range.Start, .Paragraphs(sayici).Range.End)
cevap = MsgBox(Str(sayici) & ". paragrafta toplam" & Str(adet) & aralik.Words.Count & " kelime vardır." & _
vbCrLf & "İncelemeye devam etmek istiyor musunuz?", vbYesNo + vbInformation + vbDefaultButton1, "Bilgi")
If cevap = vbNo Then Exit Sub ' hayir cevabı ile islem sona eriyor.
'kelimeler okunuyor
For adet = 1 To aralik.Words.Count
MsgBox Str(adet) & ". inci kelime = " & aralik.Words(adet), vbOKOnly + vbInformation, "Bilgi"
'resimler kelimesini renklendiriyoruz.
If aralik.Words(adet) = "Resimler" Then
aralik.Words(adet).Font.Bold = True
aralik.Words(adet).Font.Italic = True
aralik.Words(adet).Font.ColorIndex = wdRed
End If
Next ' adet, kelimeleri saymak icin
Next ' sayici, paragraflari saymak icin
End If
End With
End Sub
Private Sub btnSifrecoz_Click()
Dim cevap As String
cevap = InputBox("Sihirli kelimeyi girin", "Şifreyi çözmek için anahtar kelimeyi girin")
If cevap = "lütfen" Then
karakterleriGizle 3, False
End If
End Sub
Private Sub btnSifrele_Click()
karakterleriGizle 3, True
End Sub
Yardımcı olması dileğiyle. Güç sizinle olsun.