利用excel生成pdm表结构

第一步：整理Excel表结构（放到指定位置）

第二步：利用脚本生成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
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.Application.Visible = True
   x1.Workbooks.Open "C:\jsxm.xlsx"'excel所在位置
   x1.Workbooks(1).Worksheets("Sheet1").Activate'活动的sheet
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  shtIdx
for shtIdx=1 to x1.Workbooks(1).Worksheets.Count	
	on error Resume Next

	With x1.Workbooks(1).Worksheets(shtIdx)
		If .Cells(1, 1).Value = "if_t_buildProject" Then'判断表
			count = count + 1       	        
			set table = mdl.Tables.CreateNew
			table.Code = .Cells(1, 1).Value'表编码（对应excel的位置）
			table.Name = .Cells(1, 2).Value'表名
			table.Comment = .Cells(1, 3).Value'描述
		
			For rwIndex = 3 To 255'从第三列开始    				
				If .Cells(rwIndex, 3).Value <> "" Then'类型不为空的
					set col = table.Columns.CreateNew
					col.Name = .Cells(rwIndex, 1).Value'字段名
					col.Code = .Cells(rwIndex, 2).Value'字段编码
					col.Comment = .Cells(rwIndex, 8).Value'字段描述所在列
					col.DataType =  .Cells(rwIndex, 3).Value'数据类型
						                         
        End If
      Next
    End If
  End With


Next

x1.Application.Quit
Set x1=Nothing

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

资源地址