Execl编写表结构导入PD，PD生成sqlserver脚本

一、编写Execl文档--设计表结构

二、通过代码导入PD

Option Explicit   
Dim mdl ' the current model 
Set mdl = ActiveModel 
If (mdl Is Nothing) Then   
  MsgBox "There is no Active Model" 
End If 
  
Dim bsheetname 
bsheetname="TB_SystemScreenData"

Dim HaveExcel 
Dim RQ  
RQ = vbYes
If RQ = vbYes Then  
   HaveExcel = True  
 Dim x1
 Set x1 = CreateObject("Excel.Application")
  x1.Workbooks.Open "E:\devlopment\webform\soft\2020Core框架\01开发源代码\Us.eIOP.Dev\Us.eIOP.Web\usdev\db\databaseDeveIOP.xlsx" 
  x1.Workbooks(1).Worksheets(bsheetname).Activate 
Else
   HaveExcel = False 
End If 
a x1, mdl 
sub a(x1,mdl) 
Dim rwIndex 
Dim tableName 
Dim colname 
Dim table 
Dim col 
Dim count 

Dim T_CName '表中文名称
Dim T_EName '表英文名称
Dim T_Comment '表说明

Dim C_Default '默认值
Dim C_NotNull '是否必填
Dim C_Primary '是否主键
Dim C_Code '字段名称

With x1.Workbooks(1).Worksheets(bsheetname)
T_CName = .Cells(1,2).Value
T_EName = .Cells(2,2).Value
T_Comment = .Cells(2,6).Value
End With 
 
'MsgBox "表名称：" + T_CName+""+T_EName, vbOK + vbInformation, "表" 


SET table = mdl.Tables.CreateNew 
        table.Name = T_CName 
        table.Code = T_EName 
        table.Comment = T_CName 

'on error Resume Next 
For rwIndex = 4 To 200 step 1   
    With x1.Workbooks(1).Worksheets(bsheetname)
   If .Cells(rwIndex, 3).Value = "" Then 
       Exit For 
   End If  
    If .Cells(rwIndex, 3).Value <> "" Then 
    colName = .Cells(rwIndex, 1).Value 
    
    C_Default = .Cells(rwIndex, 6).Value 
    C_NotNull =  .Cells(rwIndex, 5).Value 
    C_Primary=  .Cells(rwIndex, 4).Value 
    C_Code=  .Cells(rwIndex, 2).Value 
    
    set col = table.Columns.CreateNew  
    col.Name = colName
    col.Code = C_Code 
    col.Comment = colName  
    col.DataType = .Cells(rwIndex, 3).Value 
    
    IF C_Default<>"" THEN
      col.DefaultValueDisplayed = C_Default
     
    END IF
    IF C_NotNull= "是" THEN
       col.Mandatory = True
    END IF
    IF C_Primary= "是" THEN
       col.Primary = True
    END IF

    IF LCase(C_Code)="id" THEN
        col.Identity=True
        'col.Replica = True
    END IF
    
    
   End If 
  End With 
Next 
  
MsgBox "生成数据表结构:" + T_CName+","+T_EName, vbOK + vbInformation, "表" 
 
Exit Sub 
End sub