FEST-İ BURSA 2015

     Değirmenlikızık Eğitim Kurumları bünyesinde eğitim gören öğrencilere destek amaçlı yapılan 10 gün devam edecek olan Kermes organizasyonu. Açılış : 29 Ağustos 2015 Saat 11:00 

Yer: Yıldırım Belediyesi Bayrak Alanı

Excel VBA Hücreye Açıklama Ekleme

Sub AciklamaEkle()

   Dim S1 As Worksheet

   Set S1 = Worksheets("Sayfa1")

   Call Aciklama_Ekle (S1.Cells(1, 1), "Açıklama Eklendi")

End Sub

Function Aciklama_Ekle(hucre As Range, note As String)

   Dim cmt As Comment

   Set cmt = hucre.Comment

   If cmt Is Nothing Then

      Set cmt = hucre.AddComment

      cmt.Text Text:=note

   Else

      note = note & Chr(10) & cmt.Text

      cmt.Text Text:=note

      If cmt.Shape.Height < 150 Then cmt.Shape.Height = cmt.Shape.Height + 20

   End If

   cmt.Visible = False

End Function

Excel VBA Hücreye link verme

Sub linkverdene()

   Dim S1 As Worksheet

   Dim S2 As Worksheet

   Set S1 = Worksheets("Sayfa1")

   Set S2 = Worksheets("Sayfa2")

   Call linkver(S1.Cells(1, 1),S2.Cells(1, 1))

   Call linkver(S2.Cells(1, 1),S1.Cells(2, 1))

End Sub

  

Function linkver(nereye As Range, neresi As Range)

     Dim adres As String

     adres = neresi.Address(RowAbsolute:=False)

     Mid(adres, 1, 1) = "!"

     adres = neresi.Worksheet.Name & adres

     nereye.Hyperlinks.Add nereye, Address:="", SubAddress:=adres, ScreenTip:=adres

End Function

Microstation VBA Yazılara ek vermek

Program Facebook "Microstation Kullanıyorum" grubu üyelerini isteği üzerine yapılmıştır.

Yükle

Yazı Ek programı Microstation VBA ile yazılmış bir programdır. Amacı text elementlerinin önüne ve/veya arkasına ilaveler yaptırmak. Öncelikle Microstationda Utilities-Macro-Project Manager Penceresini açalım ve yaziek adında yeni bir mvba dosyası oluşturalım. VBA düzenleme kısmında yandaki isimlerde bir form ve modül oluşturalım. Forma yandaki gibi nesneleride oluşturalım ve nesnelerin komutlarını yazalım. Ayrıntıları videoda bulabilirsiniz.

'--------------------------------------------------------------------------------------------------
Sub TextEk_main()
  Form_YaziEk.Show
End Sub

'--------------------------------------------------------------------------------------------------
Function Text_Guncelle(eText As TextElement)
   eText.Text = Form_YaziEk.TBOnek & eText.Text & Form_YaziEk.TBSonek
   eText.Redraw
   eText.Rewrite
End Function

'--------------------------------------------------------------------------------------------------

FormYazi_Ek Formu Kodları

  
'--------------------------------------------------------------------------------------------------
Private Sub CBFence_Click()
  Dim oElement As Element    ' Element bilgilerini içerecek bir değişken
  Dim oScanEnumerator As ElementEnumerator  'Element sayacı
  Dim oFence As Fence 
  Set oFence = ActiveDesignFile.Fence
  If oFence.IsDefined Then
     Set oScanEnumerator = oFence.GetContents
     Do While oScanEnumerator.MoveNext
        Set oElement = oScanEnumerator.Current
        If oElement.Type = msdElementTypeText Then
           Call Text_Guncelle(oElement.AsTextElement)
        End If
     Loop
 End If
End Sub
'--------------------------------------------------------------------------------------------------
Private Sub CBSecili_Click()
  Dim oElement As Element
  Dim oScanEnumerator As ElementEnumerator
  Set oScanEnumerator = ActiveModelReference.GetSelectedElements
  Do While oScanEnumerator.MoveNext
    Set oElement = oScanEnumerator.Current
    If oElement.Type = msdElementTypeText Then
       Call Text_Guncelle(oElement.AsTextElement)
    End If
  Loop
End Sub
'--------------------------------------------------------------------------------------------------
Private Sub CBTumu_Click()
  Dim oElement As Element
  Dim oScanEnumerator As ElementEnumerator
  Dim oScanCriteria As ElementScanCriteria
  Set oScanCriteria = New ElementScanCriteria
  oScanCriteria.ExcludeAllTypes
  oScanCriteria.IncludeType msdElementTypeText
  Set oScanEnumerator = ActiveModelReference.Scan(oScanCriteria)
  Do While oScanEnumerator.MoveNext
    Set oElement = oScanEnumerator.Current
    If oElement.Type = msdElementTypeText Then
       Call Text_Guncelle(oElement.AsTextElement)
    End If
  Loop
End Sub
'--------------------------------------------------------------------------------------------------
Private Sub Image1_Click()
  Call Navigate("http://bybesu.blogspot.com.tr/2015/01/microstation-vba-yazlara-ek-vermek.html")
End Sub
'--------------------------------------------------------------------------------------------------

Hasan Basri KARA Harita Mühendisi

Bursa Büyükşehir Belediyesi Coğrafi Bilgi Sistemleri Şube Müdürlüğü