Excel’den Alan Adı Değiştirme Makrosu ( Change Field Names from Excel Macro )

Sub Main
Dim I,J,O,SEL,xls,XLSPATH,ALAN,DEG,CL,bd,U,V,R,W
DIM NO(50000,2)

'U=MSGBOX (" Bu makronun sağlıklı çalışması için  " & chr(10) & " 1. Sütuna ( A Sütunu ) Netcad projenizdeki alan isimlerini" & chr(10) & " 2. Sütuna ( B Sütunu ) Yeni Alan isimlerini" & chr(10) & " giriniz.",VBYESNO,"Excelden Alan Adı Değiştir")
' Mesaj kutusu, kullanıcıya Excel dosyasını nasıl hazırlayacağını bildirir
' A message box informs the user how to prepare the Excel file

'IF U<>6 THEN EXIT SUB
'CL=0:U=0:R=0 :DEG = ""

  set xls = CreateObject("excel.application")
  set BD = Netcad.NewBDialog("Excelden Alan Adı Değiştirme...")
  bd.PutPrompt "- XLS Formatındaki Excel dosyasında 1.Sütuna(A) Netcad projesindeki alan isimlerini "
  bd.PutPrompt "- 2.Sütuna(B) yerine yazılacak yeni alan isimlerini giriniz ve adımları izleyiniz. "
  ' Kullanıcıya talimatları gösteren bir diyalog kutusu oluşturulur
  ' A dialog box is created to display instructions to the user
  
  BD.GetFileName "item7","Excel Dosyasını Seçiniz...","D:\","Excel Dosyalari|*.xls|Tum Dosyalar|*.*","xls"
  BD.GetCheck "item1", "Eski İsimleri GIS Adına Aktar", 0
  BD.GetCheck "item2", "Eski İsimleri GIS Sınıfına Aktar", 0
  ' Excel dosyasını seçmek için dosya gezgini ve ek seçenekler sunulur
  ' A file explorer and additional options are provided for selecting the Excel file
  
 Dim SEC1,SEC2 
 if BD.showmodal then
    xlspath = BD.ValueByName("item7")
     SEC1 = BD.ValueByName("item1")
     SEC2 = BD.ValueByName("item2")
  else
    exit sub
  end if
  set BD = Nothing
  xls.workbooks.open(xlspath)
  xls.range("A1").select

 FOR U=1 TO 50000
   CL=CL+1
   NO(U,1)="*" & XLS.CELLS(U,1)
   NO(U,2)=XLS.CELLS(U,2)
 IF  NO(U,2)="" THEN   NO(U,2)=0
 IF  NO(U,1)="*" THEN  U=50000
 NEXT
 ' Excel’deki veriler okunur ve bir diziye aktarılır
 ' Data from Excel is read and stored in an array
 xls.quit
   MSGBOX CL-1  & " adet Alanı Adı Exceldeki gibi değiştirilecek" & chr(10) & "   Değişmesini istediğiniz alanları Seçiniz"
   ' Kullanıcıya kaç alanın değiştirileceği bildirilir
   ' The user is informed how many fields will be updated
  with Netcad
    set SEL = .NewSelectionSet
    set o = .NewObject

    if SEL.SELECT("Alan Objelerini Seçiniz...",array(opline)) then

      for i = 0 to SEL.NE-1
        j = SEL.GetSelectedObject(i, o)
        alan =  o.pname
       
   '  MSGBOX   ":" & alan & ":"
   ' Her bir alan objesinin ismi kontrol edilir
   ' The name of each field object is checked

 FOR V=1 TO CL
       W=NO(V,1)
 if  W ="*" & alan then
            o.PNAME =  NO(V,2)
             if SEC1=1 then o.objname = ALAN
              if SEC2=1 then o.cls = ALAN 
            .putobject j, o
        NO(V,1)="**"
    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  Alan Adı Değiştirildi"
' İşlem tamamlandığında değiştirilen alan sayısı bildirilir
' The number of updated fields is reported upon completion
end sub