Dim mdl ' thecurrent model
Set mdl =ActiveModel
If (mdl Is Nothing) Then
MsgBox "没有活动的模版"
End If
Dim HaveExcel
Dim RQ
RQ = 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"C:\Users\zhfeng\Desktop\pdm.xlsx" '指定excel文档路径
Else
HaveExcel =False
End If
call a(x1, mdl)
sub a(x1, mdl)
dim rwIndex
dim tableName
dim colname
dim table
dim col
dim count,total,sheet
on error Resume Next
for total = 1 to 100
set sheet = nothing
set sheet = x1.Workbooks(1).Worksheets("Sheet"+cstr(total))
With sheet '需要循环的sheet名称
if .cells(1,1).value = "" then
exit for
end if
set table = mdl.Tables.CreateNew '创建一个表实体
table.Name =.cells(1,1).value '指定表名,如果在Excel文档里有,也可以 .Cells(rwIndex, 3).Value 这样指定
table.comment =.cells(1,1).value
table.Code =.cells(1,2).value'指定表名编码
count = count +1
For rwIndex = 3 To 1000 '指定要遍历的Excel行标,此处第一列为列名,古从第二行开始循环
If.Cells(rwIndex, 1).Value = "" Then
Exit For
End If
set col =table.Columns.CreateNew '创建一列/字段
col.Name =.Cells(rwIndex, 1).Value '指定列名
col.Code =.Cells(rwIndex, 2).Value '指定列名编码
col.DataType =.Cells(rwIndex, 3).Value '指定列数据类型
col.Length =.Cells(rwIndex, 4).Value '指定字段长度
col.Precision =cint(.Cells(rwIndex, 5).Value) '指定字段长度
'指定主键
If.Cells(rwIndex, 6).Value = "Y" Then
col.Primary =true
End If
'指定列是否可空 true 为不可空
If.Cells(rwIndex, 7).Value = "N" Then
col.Mandatory =true
End If
col.Comment =.Cells(rwIndex, 8).Value '指定列说明
Next
End With
next
set mdl = Nothing
MsgBox "生成数据表结构共计 " + CStr(count), vbOK+ vbInformation, "表"
Exit Sub
End sub