Makro Hakkında:
Excel’de xls formatlı dosyanızda 1. sütuna parsel numarası,2.sütuna GIS SINIFI yazınız. Parsel numaralarının netcad projeniz ile aynı olmasına dikkat ediniz. Böylece excele yazdığınız GIS SINIFLARI netcad projenizdeki alanlara yazdırılır.
- Makroda Üzerinde Çalıştığımız Gelişmeler:
- Şu anlık üzerinde çalıştığımız bir gelişme bulunmamaktadır. Kullanıcılardan gelen istekler ve editörlerimizin çalışmaları ile olası gelişmeler yayımlanacaktır. Bizi takip ediniz.
- Etiketler: Basit düzey makro, Netcad, Makro, Pratik Netcad, Netcad Araçları, Netcad tabaka, netcad seçim, Pratik Netcad, Netcadde nasıl yapılır,netcad menü, netcad araç, nvb, ücretsiz makro, harita makro,
Uyarılar:
- Exceldeki sütun adları ile kullanıcı formundaki sütun adlarının aynı olmasına dikkat ediniz.
- Bu makro ile en fazla 50bin satır excel satırı okunabilir.
- Exceldeki parsel no ile projedeki parsel no eşleşmesi durumunda Önceki GIS SINIFI silinir ve bu işlem geri alınmaz
- Excel dosyasındaki parsel no sütunundaki tüm parseller projenizde taranacak. Bu durumda
- Bir parselden aynı isimli birden fazla olması durumunda GIS SINIFI hatası olacağını unutmayınız
- GIS SINIFI sütununda sayı olmayan karakter kullanmayınız. Yazdığınız GIS sınıfının netcad bağlantı yöneticisinde olması gerektiğini unutmayınız
- Excel ile netcad projesinde eşleşmeyen alanlarda GIS SINIFI değiştirme yapılmayacaktır. Eski GIS SINIFI aynı kalacaktır.
- Netcad makrolarında hiçbir metni veya karakteri değiştirmeyiniz. Aksi halde makro işlevsiz hale gelebilir veya hatalı işlev ile karşılaşabilirsiniz.
İndirme Linkleri:
İndirme Linki-1: Google Drive ( Harita Akademi )
Makro Açık Kaynak Kodu:
'' www.sabangul.com.tr Web Sayfasından İndirilmiştir ' Şaban GÜL , Harita Mühendisi ' Her Türlü Hata, İstek ve Öneriler İçin ' haritaakademi@gmail.com veya sagulnet@gmail.com ' adresine durumu anlatan bir e-posta gönderiniz. Sub Main with netcad Dim i dim j dim o dim SEL dim xls dim xlspath dim alan dim DEG dim CL dim bd DIM U,V,R,W dim ruhangul dim elifyaren DIM NO(50000,2) DEG = "" CL=0:U=0:R=0 set xls = CreateObject("excel.application") set BD = Netcad.NewBDialog("GIS Sınıfının Excelden Alınması [Harita Akademi, Şaban GÜL]") BD.GetFileName "item1","Aktarım Yapılacak Excel Dosyası Seçiniz:","","Excel Dosyalari|*.xls|Tum Dosyalar|*.*","xls" BD.Getcombo "item2","Parsel Numarası Hangi Sütunda Bulunuyor ? ","A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z" ,0 BD.Getcombo "item3","GIS Sınıfı Hangi Sütunda Bulunuyor ? ","A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|W|X|Y|Z" ,1 if BD.showmodal then xlspath = BD.ValueByName("item1") else exit sub end if dim saban,ruhan saban= BD.ValueByName("item2") ruhan= BD.ValueByName("item3") saban=1 ruhan=2 if BD.ValueByName("item2")="A" then saban=1 if BD.ValueByName("item2")="B" then saban=2 if BD.ValueByName("item2")="C" then saban=3 if BD.ValueByName("item2")="D" then saban=4 if BD.ValueByName("item2")="E" then saban=5 if BD.ValueByName("item2")="F" then saban=6 if BD.ValueByName("item2")="G" then saban=7 if BD.ValueByName("item2")="H" then saban=8 if BD.ValueByName("item2")="I" then saban=9 if BD.ValueByName("item2")="J" then saban=10 if BD.ValueByName("item2")="K" then saban=11 if BD.ValueByName("item2")="L" then saban=12 if BD.ValueByName("item2")="M" then saban=13 if BD.ValueByName("item2")="N" then saban=14 if BD.ValueByName("item2")="O" then saban=15 if BD.ValueByName("item2")="P" then saban=16 if BD.ValueByName("item2")="Q" then saban=17 if BD.ValueByName("item2")="R" then saban=18 if BD.ValueByName("item2")="S" then saban=19 if BD.ValueByName("item2")="T" then saban=20 if BD.ValueByName("item2")="U" then saban=21 if BD.ValueByName("item2")="V" then saban=22 if BD.ValueByName("item2")="W" then saban=23 if BD.ValueByName("item2")="X" then saban=24 if BD.ValueByName("item2")="Y" then saban=25 if BD.ValueByName("item2")="Z" then saban=26 if BD.ValueByName("item3")="A" then ruhan=1 if BD.ValueByName("item3")="B" then ruhan=2 if BD.ValueByName("item3")="C" then ruhan=3 if BD.ValueByName("item3")="D" then ruhan=4 if BD.ValueByName("item3")="E" then ruhan=5 if BD.ValueByName("item3")="F" then ruhan=6 if BD.ValueByName("item3")="G" then ruhan=7 if BD.ValueByName("item3")="H" then ruhan=8 if BD.ValueByName("item3")="I" then ruhan=9 if BD.ValueByName("item3")="J" then ruhan=10 if BD.ValueByName("item3")="K" then ruhan=11 if BD.ValueByName("item3")="L" then ruhan=12 if BD.ValueByName("item3")="M" then ruhan=13 if BD.ValueByName("item3")="N" then ruhan=14 if BD.ValueByName("item3")="O" then ruhan=15 if BD.ValueByName("item3")="P" then ruhan=16 if BD.ValueByName("item3")="Q" then ruhan=17 if BD.ValueByName("item3")="R" then ruhan=18 if BD.ValueByName("item3")="S" then ruhan=19 if BD.ValueByName("item3")="T" then ruhan=20 if BD.ValueByName("item3")="U" then ruhan=21 if BD.ValueByName("item3")="V" then ruhan=22 if BD.ValueByName("item3")="W" then ruhan=23 if BD.ValueByName("item3")="X" then ruhan=24 if BD.ValueByName("item3")="Y" then ruhan=25 if BD.ValueByName("item3")="Z" then ruhan=26 set BD = Nothing xls.workbooks.open(xlspath) xls.range("A1").select FOR U=1 TO 100000 CL=CL+1 NO(U,1)="*" & XLS.CELLS(U,saban) NO(U,2)= XLS.CELLS(U,ruhan) IF NO(U,2)="" THEN NO(U,2)=0 IF NO(U,1)="*" THEN U=100000 NEXT xls.quit set SEL = .NewSelectionSet set o = .NewObject if SEL.SELECT("CokluDogru,Alan,Nokta ve Yazı Objelerini Seçiniz...",array(opline,oline,opoint,otext)) then for i = 0 to SEL.NE-1 j = SEL.GetSelectedObject(i, o) alan = o.cls on error resume next FOR V=1 TO CL W=NO(V,1) if W ="*" & alan then o.cls = NO(V,2) .putobject j, o R=R+1 'MSGBOX alan & " : " & NO(V,1) & " : " & NO(V,2) V=U end if NEXT next SEL.RedrawAndRewind end if set SEL = nothing set o = nothing end with MSGBOX R & " adet Parselin GIS Sınıfı Değiştirildi." end sub
1 thought on “Excelden GIS Sınıfın Aktarılması(Netcad Makro)”
Fırat POLAT
(22 Aralık 2019 - 18:28)Şaban Kardeş emeğine sağlık yalnız bu makron düzgün çalışmıyor gis sınıfını aktarmıyor