通过excle的内容生成pdm

Option Explicit

Dim mdl ‘ the current model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
    MsgBox "There is no Active Model"
End If

Dim HaveExcel
Dim RQ
Dim x1sApp,xlsWorkBook,xlsSheet
RQ = vbYes ‘MsgBox("Is Excel Installed on your machine ?", vbYesNo + vbInformation, "Confirmation")
If RQ = vbYes Then
    HaveExcel = True
    ‘ Open & Create Excel Document

    Set x1sApp = CreateObject("Excel.Application")
    set xlsWorkBook = x1sApp.Workbooks.Open("E:\1.xlsx")   ‘指定excel文档路径
    set xlsSheet = x1sApp.Workbooks(1).Worksheets("sheet1")   ‘指定要打开的sheet名称
Else
    HaveExcel = False
End If

a x1sApp, mdl,x1sApp,xlsWorkBook,xlsSheet

sub a(x1, mdl,x1sApp,xlsWorkBook,xlsSheet)

    dim rwIndex
    dim tableName
    dim colname
    dim table
    dim col
    dim count
    dim rowCount
    tableName = ""
    rowCount = xlsSheet.usedRange.Rows.Count

    on error Resume Next

    For rwIndex = 2 To rowCount   ‘指定要遍历的Excel行标  由于第1行是表头，从第2行开始
        With xlsSheet
            If .Cells(rwIndex, 2).Value = "" Then ‘如果遍历到第2列为空，则退出
                Exit For
            End If
            If tableName <> .Cells(rwIndex,2) Then ‘如果表名不同，则表示新建表
                set table = mdl.Tables.CreateNew     ‘创建表
                table.Name = lcase(.Cells(rwIndex , 3).Value) ‘指定表名，第2列的值
                table.Code = .Cells(rwIndex , 2).Value
                table.Comment = .Cells(rwIndex , 3).Value ‘指定表注释，第3列的值
                count = count + 1
                tableName = .Cells(rwIndex,2) ‘获取表名
            end if

            set col = table.Columns.CreateNew   ‘创建一列/字段
            ‘MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"

            if .Cells(rwIndex,5).Value  = "" then    ‘指定列名，如果备注不为空，则用备注信息，否则用code的全小写信息
                col.Name = lcase(.Cells(rwIndex, 4).Value)   
            else
                col.Name = .Cells(rwIndex,5).Value
            end if
            ‘MsgBox col.Name, vbOK + vbInformation, "列"
            col.Code = .Cells(rwIndex, 4).Value   ‘指定列编码
            col.DataType = .Cells(rwIndex, 7).Value ‘指定列数据类型
            ‘MsgBox col.DataType, vbOK + vbInformation, "列类型"
            col.Comment = .Cells(rwIndex,6).Value  ‘指定列说明

            if .Cells(rwIndex, 8).Value = "Y" Then    ‘设置主键信息
                col.Primary = true
            End If

            if .Cells(rwIndex, 10).Value = "Y" Then    ‘设置主键自增长
                col.Identity = true
            End If
            
            If.Cells(rwIndex, 9).Value = "NO" Then    ‘设置非空属性
                col.Mandatory =true
            End If
        End With
    Next

    MsgBox "生成数据表结构共计 " + CStr(count), vbOK + vbInformation, "表"

    xlsWorkBook.Close
    x1sApp.Quit

    set x1sApp = nothing
    set xlsWorkBook = nothing

    Exit Sub

End sub