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.