VBA kodlarıyla ofis programlarına bağlantı kurulabilir ve programla ilgili birçok işlem yaptırılabilir.
AutoCAD VBA'dan Excel'e bağlantı kurulabildiği gibi tersi de mümkündür
Hatta birçok uyumlu Windows programı birbiri ile bağlanıp kodlarla işlemler yapabilir.
Bu videoda AutoCAD VBA ile Excel'e bağlanmayı ve veri aktarmayı göstermeye devam ediyorum.
- Excele sayfa ekle
- Excel sayfası silme
- AutoCAD çizim nesne adlarını Excele yaz
- AutoCAD çizim alanındaki çizgilerin uzunluklarını ve toplamını Excele yaz
- Excel dosyasını aç
Videoda kullanılan VBA kodları:
'Mesut Akcan
'https://mesutakcan.blogspot.com
'https://youtube.com/mesutakcan
'makcan@gmail.com
Sub excelDosyaAc2()
'1. yöntem: Erken bağlanma. Early Binding
'Tools / References / Microsoft Excel xx.x Object Library ekle
Dim xla As Excel.Application 'Excel uygulamasını temsil eden nesne
Dim wb As Excel.Workbook 'Excel çalışma kitabını temsil eden nesne
Set xla = Excel.Application
xla.Visible = True 'uygulamayı ekranda göster
Set wb = xla.Workbooks.Open("c:\test\test2.xlsx") 'dosyayı excel ile aç
End Sub
Sub excelDosyaAc1()
'1. yöntem: Erken bağlanma. Early Binding
'Tools / References / Microsoft Excel xx.x Object Library ekle
Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
xla.Visible = True 'ekranda excel nesnesini göster
Dim dosya As Excel.Workbook 'excel çalışma kitabı nesnesi
Set dosya = xla.Workbooks.Open("c:\test\test1.xlsx") 'dosyayı excel ile aç
End Sub
Sub exceleYaz6()
'1. yöntem: Erken bağlanma. Early Binding
'Tools / References / Microsoft Excel xx.x Object Library ekle
Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
xla.Workbooks.Add 'Yeni dosya oluştur.
xla.Visible = True 'ekranda excel nesnesini göster
Dim sayfa As Excel.Worksheet 'excel sayfası nesnesi
Set sayfa = xla.ActiveSheet
sayfa.Name = "Liste"
Dim ent As AcadEntity 'AutoCad Varlık
For Each ent In ThisDrawing.ModelSpace 'Çizim alanındaki tüm varlıklar
If ent.ObjectName = "AcDbLine" Then
satir = satir + 1
uz = ent.Length
sayfa.Cells(satir, 2) = uz
toplamUzunluk = toplamUzunluk + uz
End If
Next
sayfa.Cells(satir + 1, 1).Value = "TOPLAM:"
sayfa.Cells(satir + 1, 2).Value = toplamUzunluk
sayfa.Cells(satir + 1, 2).Font.color = vbRed
sayfa.SaveAs "c:\TEST\test2.xlsx" 'Dosyaya kaydet
End Sub
Sub exceleYaz5()
'1. yöntem: Erken bağlanma. Early Binding
'Tools / References / Microsoft Excel xx.x Object Library ekle
Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
xla.Workbooks.Add 'Yeni dosya oluştur.
xla.Visible = True 'ekranda excel nesnesini göster
Dim sayfa As Excel.Worksheet 'excel sayfası nesnesi
'Son sayfadan sonra ekle
Set sayfa = xla.Worksheets.Add(After:=xla.Worksheets(xla.Worksheets.Count))
sayfa.Name = "TEST"
Dim ent As AcadEntity 'AutoCad Varlık
For Each ent In ThisDrawing.ModelSpace 'Çizim alanındaki tüm varlıklar
satir = satir + 1 'satır numarasını 1 arttır
sayfa.Cells(satir, 1).Value = ent.ObjectName 'hücreye nesne adını yaz
Next
sayfa.SaveAs "c:\TEST\test1.xlsx" 'Dosyaya kaydet
End Sub
Sub exceleYaz4()
'1. yöntem: Erken bağlanma. Early Binding
'Tools / References / Microsoft Excel xx.x Object Library ekle
Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
xla.Workbooks.Add 'Yeni dosya oluştur.
xla.Visible = True 'ekranda excel nesnesini göster
Dim sayfa As Excel.Worksheet 'excel sayfası nesnesi
'Set sayfa = xla.Worksheets.Add(After:=xla.Worksheets(xla.Worksheets.Count)) 'Son sayfadan sonra yeni sayfa ekle
'2. sayfadan sonra ekle
Set sayfa = xla.Worksheets.Add(After:=xla.Worksheets(2))
sayfa.Name = "TEST"
'TEST sayfasından sonra ekle
Set sayfa = xla.Worksheets.Add(After:=xla.Worksheets("TEST"))
sayfa.Name = "DENEME"
'TEST sayfasından önce ekle
Set sayfa = xla.Worksheets.Add(Before:=xla.Worksheets("TEST"))
sayfa.Name = "HESAP"
sayfa.Delete
Set sayfa = xla.Worksheets("TEST")
sayfa.Delete 'sayfa sil
xla.Worksheets("DENEME").Delete 'sayfa sil
End Sub
Sub exceleYaz3()
'2. yöntem: Geç bağlanma. Late Binding
Dim xla As Object 'nesne için değişken tanımla
Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
xla.Visible = True 'ekranda excel nesnesini göster
Dim wb As Object 'nesne için değişken tanımla
Set wb = xla.Workbooks.Add 'Yeni dosya oluştur.
Dim sayfa As Object 'nesne için değişken tanımla
Set sayfa = wb.Worksheets.Add 'yeni dosya oluştur
sayfa.Name = "TEST" 'sayfa adını değiştir.
sayfa.Cells(4, 3) = "Merhaba" 'satır 4, sütun 3'e Merhaba yaz
End Sub
Sub exceleYaz2()
'1. yöntem: Erken bağlanma. Early Binding
'Tools / References / Microsoft Excel xx.x Object Library ekle
Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
xla.Workbooks.Add 'Yeni dosya oluştur.
xla.Visible = True 'ekranda excel nesnesini göster
'xla.Worksheets.Add 'yeni excel sayfası ekle
Dim sayfa As Excel.Worksheet 'excel sayfası nesnesi
Set sayfa = xla.Worksheets.Add 'yeni excel sayfası ekle
sayfa.Name = "TEST" 'sayfa adını değiştir
Set sayfa = xla.Worksheets(2) 'excel 2. sayfa
sayfa.Activate 'sayfayı aktif et
With sayfa.Range("B3")
.Value = "Merhaba" 'Satır 3, Sütun 2'ye Merhaba yaz
.Interior.color = vbRed 'zemin rengi kırmızı
.Font.color = vbWhite 'yazı rengi beyaz
.Font.Bold = True 'kalın yazı
'.Select 'B3 hücresini seç
End With
End Sub
Sub exceleYaz1()
'1. yöntem: Erken bağlanma. Early Binding
'Tools / References / Microsoft Excel xx.x Object Library ekle
Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
xla.Workbooks.Add 'Yeni dosya oluştur.
xla.Visible = True 'ekranda excel nesnesini göster
With xla.Application.Range("B3")
.Value = "Merhaba" 'Satır 3, Sütun 2'ye Merhaba yaz
.Interior.color = vbRed 'zemin rengi kırmızı
.Font.color = vbWhite 'yazı rengi beyaz
.Font.Bold = True 'kalın yazı
.Select 'B3 hücresini seç
End With
xla.Quit 'Exceli kapat
End Sub
