Temel çizim nesnelerini kullanarak akış şeması simulasyonu...


VBA ile iki sayının karşılaştırılması işleminin simulasyonu.
Merhaba arkadaşlar bu çalışmamızda sizlerle iki sayının bir birlerine göre durumlarının karşılaştırılması işleminin simulasyonunu yapmaya çalışacağız.Her zaman olduğu gibi vakit kaybetmeden konuya girelim.

  1. Önce kendinize boş ve yeni bir belge oluşturun
  2. Sonra gerekli makro güvenlik ayarlarını yapın
  3. Visual Basic araç çubuğunu kullanarak tasarım modunu etkinleştirin
  4. Belgenize iki adet düğme ekleyin ve aşağıda belirtilen özelliklerine yine aşağıda belirtilen değerleri girin
    1. Düğme  name: btnKarsilastir Caption: KARŞILAŞTIR
    2. Düğme  name: btnCikis Caption: ÇIKIŞ
  5. Daha sonra Şekil-1 de verilen akış şemasını çizin. Bunu yaparken çizim araç çubuğundaki  akış şeması kategorisindeki şekillerden faydalanabilirsiniz.
    Şekil-1
  6. Sonuçta iki adet sayıyı karşılaştıracağımıza göre kullanıcıdan bu sayıları girmesini isteceğimiz bazı elemanlara ihityacımız olacak. Aslında burada TextBox (Visual Basic Araç Çubuğu yardımıyla eklenen metin kutusu nesnesi)  kullanmak mümkün ama ben hazırladığımız örnekte çizim araç çubuğunun yardımıyla eklenen Metin Kutusunu tercih ettim.
  7. Son olarak Alt+F11 ile kod sayfasına geçerek aşağıda verilen kodları yazın. Olmadı kaynak dosyayı indirin ve deneyin. Aslında "ben öğrenmek istiyorum..." diyorsanız bence oturun ve kodlayın daha faydalı olacaktır. Bu arada hemen her bir kod satırından önce o satırın işlevine dair küçük açıklamalar eklediğim için ayrıca kodları izah etme gereği duymuyorum. Şayet aklınıza takılan bir şey olursa bana mesaj atabilirsiniz.

'Tanimlanmayan degiskenlerin kullanilmasina izin vermiyoruz
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 etkinlestir(nesneID As Integer)
'***********************************************************************************************
'Kodlayan                   : Bilal SERT
'Tarih/Saat                : 11.12.2012 / 10:00
'Amaç                        : Indeski verilen nesnenin dolgu rengini degistirerek
'                                 diğer nesnelere göre etkin olarak göstermek
'Giriş/Çıkış                 : nesneID renklendirilmek istenen nesnenin indeksi
'Cağrıldığı yerler         : btnKarsilastir_Click()
'Çağırdıkları               : yok
'***********************************************************************************************
Dim bekle As Variant
With ThisDocument
        .Shapes(nesneID).Fill.Solid
        .Shapes(nesneID).Fill.ForeColor.RGB = RGB(50, 0, 200)
        '500 ms bekleme yapiliyor.
            bekle = Timer
            Do While Timer < bekle + 1
                DoEvents
            Loop
        .Shapes(nesneID).Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
End Sub
Private Sub sifirla()
'***********************************************************************************************
'Kodlayan                   : Bilal SERT
'Tarih/Saat                : 11.12.2012 / 10:00
'Amaç                        : Nesnelerin indekslerini kendilerinde görüntülemek
'Giriş/Çıkış                 : yok
'Cağrıldığı yerler         : Document_Open()
'Çağırdıkları               : yok
'***********************************************************************************************
Dim sayac As Integer
With ThisDocument
    For sayac = 1 To .Shapes.Count
         If sayac <> 2 Or sayac <> 3 Then
         'Command button nesnelerinde bu satir hata verecektir.
         'Bu nedenle biz bunu gormezden gelmek istiyoruz.
          On Error Resume Next
            .Shapes(sayac).TextFrame.TextRange = sayac
        End If
    Next
End With
End Sub
Private Sub btnKarsilastir_Click()
Dim sayi1, sayi2, sayac As Integer
sayi1 = Val(ThisDocument.Shapes(2).TextFrame.TextRange)
sayi2 = Val(ThisDocument.Shapes(3).TextFrame.TextRange)
With ThisDocument
'kutular temizleniyor
    For sayac = 1 To .Shapes.Count
         If sayac <> 2 And sayac <> 3 Then
          On Error Resume Next
            .Shapes(sayac).TextFrame.TextRange = ""
        End If
    Next
'karsilastirma baslatiliyor
    .Shapes(1).TextFrame.TextRange = "BASLA"
    etkinlestir (1)
    .Shapes(16).TextFrame.TextRange = "" 'OK
    etkinlestir (16)
    .Shapes(5).TextFrame.TextRange = "SAYI 1=" & Str(sayi1)
    etkinlestir (5)
    .Shapes(17).TextFrame.TextRange = "" 'OK
    etkinlestir (17)
    .Shapes(6).TextFrame.TextRange = "SAYI 2=" & Str(sayi2)
    etkinlestir (6)
    .Shapes(18).TextFrame.TextRange = "" 'OK
    etkinlestir (18)
    .Shapes(7).TextFrame.TextRange = Str(sayi1) & " > ? " & Str(sayi2)
    etkinlestir (7)

    If sayi1 > sayi2 Then
        .Shapes(22).TextFrame.TextRange = "" 'OK
        etkinlestir (22)
        .Shapes(13).TextFrame.TextRange = Str(sayi1) & " büyüktür"
        etkinlestir (13)
        .Shapes(23).TextFrame.TextRange = "" 'OK
        etkinlestir (23)
    ElseIf sayi1 < sayi2 Then
        .Shapes(19).TextFrame.TextRange = "" 'OK
        etkinlestir (19)
        .Shapes(10).TextFrame.TextRange = Str(sayi1) & " < ? " & Str(sayi2)
        etkinlestir (10)
        .Shapes(24).TextFrame.TextRange = "" 'OK
        etkinlestir (24)
        .Shapes(14).TextFrame.TextRange = Str(sayi1) & " küçüktür"
        etkinlestir (14)
        .Shapes(25).TextFrame.TextRange = "" 'OK
        etkinlestir (25)
    Else
        .Shapes(19).TextFrame.TextRange = "" 'OK
        etkinlestir (19)
        .Shapes(10).TextFrame.TextRange = Str(sayi1) & " < ? " & Str(sayi2)
        etkinlestir (10)
        .Shapes(20).TextFrame.TextRange = "" 'OK
        etkinlestir (20)
        .Shapes(15).TextFrame.TextRange = "Sayilar eşit"
        etkinlestir (15)
    End If
    .Shapes(21).TextFrame.TextRange = "" 'OK
    etkinlestir (21)
    .Shapes(4).TextFrame.TextRange = "DUR"
    etkinlestir (4)
End With
End Sub
Private Sub Document_Open()
'Tum sekillerin indeksleri ilk yuklemede görüntüleniyor.
    sifirla
End Sub

Yardımcı olması dileğiyle. Güç sizinle olsun.