Tabloda temel aritmatik işlemler


Tabloda Temel Aritmatik İşlemler

Bu örneğimizde pek çoğumuzun Excel çalışma sayfasında yapmayı tercih ettği basit artimatik işlemleri Word tablosunda VBA ile nasıl yapabileceğimizi göreceğiz. Şunu belitmeliyim ki burada anlatılan bu işlemi hiç VBA kullanmadan formüllerle yapmanız mümkündür, ancak unutmayında veriler üzerinde bir değişiklik olduğunda formüllerinizi manuel olarak (yani elle) güncellemeniz gerekmektedir. Bu noktada sizlere Libre Office kullanmanızı tavsiye edeceğim çünkü Libre Office, Writer programında tablolar aynen bir hesap tablosu formülü gibi davranmakta ve değişen verilere göre otomatik olarak güncellenmektedir. Şimdi isterseniz bu basit örneğimizin nasıl yapılacağı açıklamaya çalışalım.

  1. Öncelikle yeni bir belge açıyor ve makro güvenlik düzeyini düşük olarak ayarlıyoruz. Nasıl yapılacağını hatırlamak için bu bağlantıyı kullanabilirsiniz.
  2. Sonrasında aşağıda verilen tabloyu belgenize çiziyorsunuz. Bu tabloda adı geçen öğrenci arkadaşlarımı da sevgiyle anmak istiyorum. Çünkü onlar burada anlatılan örnekleri sınıfta uygulamaya çalışan gönüllülerdi umarım gençler hepiniz iyi ve mutlusunuzdur. Allah' a (c.c.) emanet olun
  3. Sonrasında aşağıda verilen ekran tasarımını yapıyor ve burada belirtilen nesnelerin name ve Caption özelliklerini ayarlıyorsunuz. Bu defaki çalışmamızda belgemizdeki  3 adet CommandButton nesnesi eklemeniz gerekiyor.

  1. Son olarak Alt + F11 il VBA kod düzenleyicisini etkin hale getiriyor ve aşağıda verilen kodları yazıyorsunuz. İşlem sonunda belgenizi test etmek için yaptıklarınızı kaydedip kapatıyor ve sonra yeniden açıyorsunuz. İşte hepsi bu kadar. Ama bunun daha kolay bir yöntemi var o da kaynak dosyayı indirip denemk artık nasıl arzı ederseniz.

Kaynak Kodlar :


'Tanimlanmayan değişkenlerin kullanılmasına izin verme
Option Explicit
Dim satir, sutun, toplam, sayac As Integer
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 btnHesapla_Click()
    With ThisDocument
'1. DONEM **************************************************************************
       For satir = 4 To .Tables(1).Rows.Count
            sayac = 0: toplam = 0
            For sutun = 4 To 8
                 'hucreye 1-100n arasinda bir deger aktariliyor
                 'bos hucrelerde vbCr karakteri yani Enter var
                If .Tables(1).Cell(satir, sutun).Range.Text <> vbCr Then
                    toplam = toplam + Val(.Tables(1).Cell(satir, sutun).Range.Text)
                    sayac = sayac + 1
                End If
            Next

            .Tables(1).Cell(satir, 9).Range.Select
            Selection.Delete
            .Tables(1).Cell(satir, 9).Range.Font.ColorIndex = wdRed
            .Tables(1).Cell(satir, 9).Range.Text = Round(toplam / sayac)
        Next
'***************************************************************************************
'2. DONEM **************************************************************************
       For satir = 4 To .Tables(1).Rows.Count
            sayac = 0: toplam = 0
            For sutun = 10 To 14
                 'hucreye 1-100n arasinda bir deger aktariliyor
                 'bos hucrelerde vbCr karakteri yani Enter var
                If .Tables(1).Cell(satir, sutun).Range.Text <> vbCr Then
                    toplam = toplam + Val(.Tables(1).Cell(satir, sutun).Range.Text)
                    sayac = sayac + 1
                End If
            Next
            .Tables(1).Cell(satir, 15).Range.Select
            Selection.Delete
            .Tables(1).Cell(satir, 15).Range.Font.ColorIndex = wdRed
            .Tables(1).Cell(satir, 15).Range.Text = Round(toplam / sayac)
        Next
'***************************************************************************************
'YILSONU **************************************************************************
       For satir = 4 To .Tables(1).Rows.Count
            toplam = Val(.Tables(1).Cell(satir, 15).Range.Text) + Val(.Tables(1).Cell(satir, 9).Range.Text)
            .Tables(1).Cell(satir, 16).Range.Select
            Selection.Delete
            .Tables(1).Cell(satir, 16).Range.Font.ColorIndex = wdBlue
            .Tables(1).Cell(satir, 16).Range.Text = Round(toplam / 2)
        Next
'***************************************************************************************
    End With
End Sub
Private Sub btnOrneklem_Click()
'Üzerinde işlem yapılacak örnek veriler yükleniyor.
With ThisDocument
'Tüm tablonu not verileri siliniyor.
Range(Tables(1).Cell(4, 4).Range.Start, Tables(1).Cell(Tables(1).Rows.Count, _
Tables(1).Columns.Count).Range.End).Select
Selection.Delete
       For satir = 4 To .Tables(1).Rows.Count
            For sutun = 4 To .Tables(1).Columns.Count
                If sutun <> 9 And sutun <> 15 And sutun <> 16 Then
'                 'hucre icindeki verileri isterseniz her
'                  veri yükleme işlemi öncesi tek tek silebilirsiniz
'                 .Tables(1).Cell(satir, sutun).Range.Select
'                 Selection.Delete
                 'hucreye 1-100n arasinda bir deger aktariliyor
                 .Tables(1).Cell(satir, sutun).Range.Text = Round(Rnd * 99 + 1)
                End If
            Next
        Next
End With
End Sub


Yardımcı olması dileğiyle