Metin kutusu ekleme ve düzenleme işlemi


Word 2003 te VBA ile Metin Kutularının Eklenmesi ve Düzenlenmesi.
Merhaba millet! Sanıyorum cümleye şöyle başlamalıyım; evet arkadaşlar bu çalışmamızda sizlerle birlikte... ama böyle olmayacak bu defa işleri olabildiğince basit ve kısa izah etmeye çalışacağım. Aslında bu çalışmamızda amaç basit bir analog saat yapmak idi ama yarım kalmıştı umarın sizler benim burada verdiklerimi alıp daha iyi bir sonuç üretirsiniz. Böylece hem birazda beyin jimnastiği yapmış olursunuz.Şimdi gelelim yapacaklarımıza:
1. Önce yeni bir belge oluşturuyor ve bu belgenin sayfa yapısı ayarlarından sayfa kullanımını yatay olarak ayarlıyoruz.
2. Sonrasında belgemizin Makro Güvenlik Ayarlarını düşük olarak ayarlıyoruz. Endişe edecek bir şey yok bendeniz de beyaz şapka kullanıyorum diyebilirim, amaç sadece bilmek ve göstermek asla insanların sistemine zarar verecek kodlar yazmamak...Unutmayın bu ayarlar bildiğiniz kodlar dışındaki herşey için yüksek konumda kalmalıdır. Burada bir kez daha yazmakta bir zarar görmüyorum, VBA ile tüm dosya sisteminize erişmek mümkündür bu ise yabancı kodlar söz konusu olduğunda sizin için büyük bir sıkıntı olabilir.
3.Tek sayfalık belgemize üç adet CommandButton nesnesi ekliyor ve bunların name ve caption özelliklerini aşağıda verildiği gibi ayarlıyoruz. Şayet name özelliklerini farklı yaparsanız bu durumda aşağıda verilen kodlarda btnSil_Click() yazan yerdeki nesne adını sizin nesne adınızla değiştirmeniz gerekecektir, bunu unutmayın. Olmayan bir nesnenin tek tıklama olayı neasıl tetiklensin değil mi?
1. Düğme  name: btnYapilandir Caption: YAPILANDIR
2. Düğme  name: btnSil Caption: NESNE SİL
3. Düğme  name: btnCikis Caption: ÇIKIŞ
4. Tüm bunlar bittikten sonra 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.
Burada size düşünmeniz için basit bir soru sormak istiyorum. Neden nesne silme işlemi bir defada tamamlanmıyor? Ha! Unutumadan söyleyeyim, ThisDocument.Shapes.Count sayfadaki nesne sayisini verir. Hadi bakalım sizlere kolay gelsin. Baktınız olmuyor ekteki dosyayı indirir ve denersiniz ama unutmayın hazır olarak tükettiğiniz hiç bir şeyin bünyenize bir faydası olmayacaktır.

'Tanimlanmayan degiskenlerin kullanilmasina izin verme
Option Explicit
Dim zaman As String, saat, dakika, saniye As Byte
Private Sub saatiCalistir()
'***********************************************************************************************
'Kodlayan                   : Bilal SERT
'Tarih/Saat                : 18.12.2012 / 09:00
'Amaç                        : Akrep, yelkovan ve saniye gostergelerini belirli bir
'                                  acida dondurmek
'
'Giriş/Çıkış                 : yok
'***********************************************************************************************
'DİKKAT ! ***********************************************************************************
'NESNELERIN MERKEZLERI UZERINDE DUZENLEME YAPILMADIGI SURECE
'BURADA YAPILAN KODLAMALARIN BIR ANLAMI YOKTUR.
'***********************************************************************************************
'''14 akrep 1 saniye 15 yelkovan
'''ThisDocument.Shapes(15).Rotation = 45
'Dim sa, sn, dk, bilgi As String, sayac As Integer, sayici As Byte
'Dim bekle As Variant
'
'bilgi = Format(Time, "hh:mm:ss")
'sayici = 1: sa = "": dk = "": sn = ""
'For sayac = 1 To Len(bilgi)
'    If Mid(bilgi, sayac, 1) <> ":" Then
'        If sayici = 1 Then
'            sa = sa & Trim(Mid(bilgi, sayac, 1))
'        ElseIf sayici = 2 Then
'            dk = dk & Trim(Mid(bilgi, sayac, 1))
'        Else
'            sn = sn & Trim(Mid(bilgi, sayac, 1))
'        End If
'    Else
'            sayici = sayici + 1
'    End If
'Next
'saat = Val(sa): dakika = Val(dk): saniye = Val(sn)
''saat ilk calistiginda akrep, saniye ve yelkovan ilk konumlarina getiriliyor
''ThisDocument.Shapes(1).Rotation = Val(sn) * 6
''ThisDocument.Shapes(15).Rotation = Val(dk) * 6
''ThisDocument.Shapes(14).Rotation = Val(sa) * 30 + (Val(dk) * 0.5)
'
'If btnAyarla.Caption = "BASLAT" Then
'    btnAyarla.Caption = "DURDUR"
'Else
'    btnAyarla.Caption = "BASLAT"
'End If
''SAAT CALISMAYA BASLIYOR
'Do
''1 saniye bekleme yapiliyor **********************
'bekle = Timer
'Do While Timer < bekle + 0.58
'    DoEvents
'Loop
''********************************************************
''TextBox1.Text = Str(saat) & " :" & Str(dakika) & " : " & Str(saniye)
'If saniye < 60 Then
'    saniye = saniye + 1
''    ThisDocument.Shapes(1).Rotation = saniye * 6
'Else
'    saniye = 0
'    If dakika < 60 Then
'        dakika = dakika + 1
''        ThisDocument.Shapes(15).Rotation = 6
'    Else
'        dakika = 0
'        If saat < 12 Then
'            saat = saat + 1
''            ThisDocument.Shapes(14).Rotation = 30
'        Else
'            saat = 0
'        End If
'    End If
'End If
'DoEvents
'Loop Until btnAyarla.Caption = "BASLAT"
End Sub
Private Sub btnSil_Click()
Dim elemanSayisi As Integer, i As Integer
'Nesneler Siliniyor **********************************************************
elemanSayisi = ThisDocument.Shapes.Count
    For i = 1 To elemanSayisi
        On Error Resume Next
        ThisDocument.Shapes(i).Delete
    Next
'********************************************************************************
End Sub
Private Sub btnYapilandir_Click()
Const pi As Double = 3.14159265358
Dim sayac, derece, yCap, xPos, yPos, mx, my As Integer
Dim sayilar As Byte
With ThisDocument
'rakamlar ekleniyor
    For sayac = 1 To 12
        .Shapes.AddTextbox msoTextOrientationHorizontal, 150, sayac * 30 + 50, 30, 30
        On Error Resume Next
        .Shapes(sayac).TextFrame.TextRange.Text = sayac
        .Shapes(sayac).TextFrame.TextRange.Font.ColorIndex = wdBlue
        .Shapes(sayac).TextFrame.TextRange.Font.Size = 16
        .Shapes(sayac).TextFrame.TextRange.Font.Bold = True
        .Shapes(sayac).Line.Visible = msoFalse
        .Shapes(sayac).TextFrame.MarginBottom = 0
        .Shapes(sayac).TextFrame.MarginLeft = 0
        .Shapes(sayac).TextFrame.MarginTop = 0
        .Shapes(sayac).TextFrame.MarginRight = 0
    Next
'rakamlar konumlarina yerleştiriliyor
'burada mx ve my saatin merkezini gostermektedir.
    mx = 320: my = 185: yCap = 150
    sayilar = 3
    For sayac = 1 To 12
        xPos = mx + (yCap * Round(Cos((sayac - 1) * 30 * pi / 180), 2))
        yPos = my + (yCap * Round(Sin((sayac - 1) * 30 * pi / 180), 2))
        .Shapes(sayac).Left = xPos
        .Shapes(sayac).Top = yPos
        .Shapes(sayac).TextFrame.TextRange.Text = sayilar
        sayilar = sayilar + 1
        If sayilar = 13 Then sayilar = 1
    Next
 'saatin çerçevesi ekleniyor
    .Shapes.AddShape 9, mx, my, 350, 350
    .Shapes(.Shapes.Count).Left = mx - 170
    .Shapes(.Shapes.Count).Top = my - 170
    .Shapes(.Shapes.Count).Fill.Visible = msoFalse
    .Shapes(.Shapes.Count).Line.ForeColor.RGB = RGB(0, 0, 255)
    .Shapes(.Shapes.Count).Line.Style = msoLineThickThin
 'akrep  ekleniyor
    .Shapes.AddLine 320, 185, 240 + yCap, 185
    .Shapes(.Shapes.Count).Left = 330
    .Shapes(.Shapes.Count).Top = 195
    .Shapes(.Shapes.Count).Line.EndArrowheadStyle = msoArrowheadTriangle
    .Shapes(.Shapes.Count).Line.Weight = 4
    .Shapes(.Shapes.Count).Line.ForeColor.RGB = RGB(255, 0, 0)
    .Shapes(.Shapes.Count).ZOrder msoSendBackward

 'yelkovan  ekleniyor
    .Shapes.AddLine 320, 185, 280 + yCap, 185
    .Shapes(.Shapes.Count).Left = 330
    .Shapes(.Shapes.Count).Top = 195
    .Shapes(.Shapes.Count).Line.EndArrowheadStyle = msoArrowheadTriangle
    .Shapes(.Shapes.Count).Line.Weight = 4
    .Shapes(.Shapes.Count).Line.ForeColor.RGB = RGB(0, 0, 255)
    .Shapes(.Shapes.Count).ZOrder msoSendBackward
 'saniye  ekleniyor
    .Shapes.AddLine 320, 185, 300 + yCap, 185
    .Shapes(.Shapes.Count).Left = 330
    .Shapes(.Shapes.Count).Top = 195
    .Shapes(.Shapes.Count).Line.Weight = 2
    .Shapes(.Shapes.Count).Line.ForeColor.RGB = RGB(0, 255, 0)
    .Shapes(.Shapes.Count).ZOrder msoSendToBack
'saatin merkezi ekleniyor
    .Shapes.AddShape 9, mx, my, 20, 20
    .Shapes(.Shapes.Count).Left = mx
    .Shapes(.Shapes.Count).Top = my
    .Shapes(.Shapes.Count).Fill.ForeColor.RGB = RGB(0, 99, 255)
    .Shapes(.Shapes.Count).Line.Visible = msoFalse
End With
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

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