Temel çizim nesnelerini renklendirme


Word 2003 te VBA ile çizim nesnelerini renklendirme
Merhaba arkadaşlar. Bu basit uygulamamızda sizlerle birlikte çizim araç çubuğunu kullanarak zaman zaman belgemize eklediğimiz nesnelerinin renklendirilmesi işlemini ele alacağız. Burada sadece daire ve dörtgen kullanılmış olmasına rağmen, siz çizim araç çubuğunu kullanarak hangi çizim nesnesini eklerseniz ekleyin onlar için de burada yapılanlar geçerli olacaktır. Çünkü sayfaya eklediğiniz her nesne Shape sınıfının bir elamanı olarak eklenenecektir. Bu arada belgeniz üzerinde yapacağız nesne ekle ve silme işlemleri eklediğiniz yeni şekillerin indekslerinin de değişmesi anlamına gelmektedir. Belgeye ilk eklenen nesnenin indeksi 1 son eklenin ise Thisdocument.shapes.count yani sayfadaki şekil sayısı olacaktır. Böyle kısacık bilgi verdikten sonra gelelim yapacaklarımıza:
1. Yeni bir belge oluşturup Makro Güvenlik Ayarlarını düşük olarak ayarlıyoruz.
2.Şekil-1 de verildiği gibi belgemize 3 adet CommandButton nesnesi (yani düğme) ve trafik ışığı görünümü elde edecek şekilde daire ve dörtgen çizim nesneleri ile trafik ışıklarının anlamlarını yazdırmak üzere bir adet metin kutusu ekliyoruz.
Şekil-1
3. Sonrasında ilk olarak aşağıda verilen kodlara bakarak  btnIndeksle_Click() olayını yazıyor ve çalıştırıyoruz. Bu işlemi mutlaka yapmalısınız çünkü bazen kullanıcılar bir şeyler çiziyor sonra beğenmiyor ve bu çizimleri siliyor derken bu işlemi bir kaç defa tekrarlıyorlar. Bu durumda da ister istemez sahneye eklediğiniz çizim nesnelerinin indeksleri bizim yazdığımız kodlardan farklılık gösteriyor. Şayet çizim işlemi sonrası indeksleme yaptıktan sonra nesnelerinizin içindeki rakamlar Şekil-1 de verilen rakamlarla aynı çıkıyorsa aşağıda verilen kodları birebir kullanabilirsiniz. Yok farklı sayılar çıkıyorsa bu durumda aşağıda verilen kodlardaki nesne indekslerinizi sizin nesne indeksleriniz ile değiştirmeniz gerekiyor demektir.
4.Her zaman olduğu gibi artık kodlama işlemine geçebiliriz. Bunun 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. Hadi hayırlı kodlamalar.

'Tanimlanmayan degiskenlerin kullanimasina izin vermiyoruz.
Option Explicit
Private Sub btnCalistir_Click()
Dim tekar As Integer
Dim zaman As Variant
If btnCalistir.Caption = "OYNAT" Then
    btnCalistir.Caption = "DURDUR"
Else
    btnCalistir.Caption = "OYNAT"
End If

Do Until btnCalistir.Caption = "OYNAT"
    With ThisDocument
        'SIFIRLA
        .Shapes(2).Fill.Solid
        .Shapes(2).Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Shapes(3).Fill.Solid
        .Shapes(3).Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Shapes(4).Fill.Solid
        .Shapes(4).Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Shapes(5).TextFrame.TextRange = "Trafik ışıkları nasıl çalışır?"
        'KIRMIZI
        .Shapes(2).Fill.Solid
        .Shapes(2).Fill.ForeColor.RGB = RGB(255, 0, 0)
        .Shapes(5).TextFrame.TextRange = "KIRMIZI - DUR"
        zaman = Timer
        Do
            DoEvents
        Loop Until Timer > zaman + 1
        'SARI
        .Shapes(3).Fill.Solid
        .Shapes(3).Fill.ForeColor.RGB = RGB(255, 255, 0)
        .Shapes(5).TextFrame.TextRange = "SARI - HAZIRLAN"
        zaman = Timer
        Do
            DoEvents
        Loop Until Timer > zaman + 1
        'YESIL
        .Shapes(2).Fill.Solid
        .Shapes(2).Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Shapes(3).Fill.Solid
        .Shapes(3).Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Shapes(4).Fill.Solid
        .Shapes(4).Fill.ForeColor.RGB = RGB(0, 255, 0)
        .Shapes(5).TextFrame.TextRange = "YEŞİL - GEÇ"
        zaman = Timer
        Do
            DoEvents
        Loop Until Timer > zaman + 1
        
    End With
    DoEvents
Loop
End Sub
Private Sub btnIndeksle_Click()
'***********************************************************************************************
'Kodlayan                   : Bilal SERT
'Amaç                        : Belgedeki metin kutularinin indekslerini kendilerine
'                                  bir metin olarak yazdirmak.
'***********************************************************************************************
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 btnCikis_Click()
'1. Acik belgeyi kaydetmeden cik
    Application.Quit wdDoNotSaveChanges
'2. Acik belgeyi kaydet ve  cik
'    Application.Quit wdSaveChanges
End Sub
Private Sub Document_Open()
Dim i As Integer
'shape nesnelerinin metin degerleri siliniyor.
    For i = 1 To ThisDocument.Shapes.Count
        On Error Resume Next
        ThisDocument.Shapes(i).TextFrame.TextRange = ""
    Next
End Sub

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