'****************************************************************************** Option ExplicitDim mdl ' the current modelSet mdl = ActiveModelIf (mdl Is Nothing) Then MsgBox "There is no Active Model"End IfDim HaveExcelDim RQRQ = vbYes 'MsgBox("Is Excel Installed on your machine ?", vbYesNo + vbInformation, "Confirmation")If RQ = vbYes Then HaveExcel = True ' Open & Create Excel Document Dim x1 ' Set x1 = CreateObject("Excel.Application") x1.Workbooks.Open "d:\111.xlsx" '指定excel文件路徑 x1.Workbooks(1).Worksheets("Sheet1").Activate '指定要開啟的sheet名稱Else HaveExcel = FalseEnd Ifa x1, mdlsub a(x1, mdl)dim rwIndexdim tableNamedim colnamedim tabledim coldim countdim abcon error Resume Next'--------------------------------'下面是讀取excel，新增表實體屬性'--------------------------------For rwIndex = 1 To 253 '指定要遍歷的Excel行標 由於第2行是表頭，從第1行開始，看你這個表設計多少行 With x1.Workbooks(1).Worksheets("Sheet1")'需要迴圈的sheet名稱 If .Cells(rwIndex,1).Value <> "" And .Cells(rwIndex,2).Value = "" And .Cells(rwIndex,3).Value <> "" Then'Excel中表頭的1列是表名，2空，3是表註釋 set table = mdl.Tables.CreateNew '建立一個表實體 table.Code = .Cells(rwIndex,1).Value'從excel中取得表名稱和編碼 table.Name = .Cells(rwIndex,3).Value' table.Comment = .Cells(rwIndex,3).Value '指定列說明 count = count + 1 Continue End If 'If (.Cells(rwIndex,1).Value = "" And .Cells(rwIndex,2).Value = "" And .Cells(rwIndex,3).Value = "") Or (.Cells(rwIndex,1).Value <> "" And .Cells(rwIndex,2).Value = "" And .Cells(rwIndex,3).Value <> "")Then If .Cells(rwIndex,2).Value = "" or .Cells(rwIndex,1).Value = "欄位" Then '第二列為空的都可以忽略 continue '這裡忽略空行和表名行、表頭行 Else set col =table.Columns.CreateNew '建立一列/欄位 col.Code = .Cells(rwIndex, 1).Value '指定列code col.DataType = .Cells(rwIndex, 2).Value '指定列資料型別 If.Cells(rwIndex, 3).Value = "主鍵" Then'指定主鍵 col.Primary =true End If If.Cells(rwIndex, 4).Value = "N" Then'指定列是否可空 true 為不可空 col.Mandatory =true End If col.Name = .Cells(rwIndex, 5).Value '指定列name col.Comment = .Cells(rwIndex, 6).Value '指定列說明 End If End WithNext MsgBox "生成資料表結構共計 " + CStr(count), vbOK + vbInformation, "表"Exit SubEnd sub