PowerDesigner根据Excel设计数据表结构 Excel表结构导入PowerDesigner PowerDesigner导出数据表结构到Excel 一个表一个Sheet 带链接目录

 Option Explicit  
		Dim shet, cnt
		' ---------------------------------------------------
		' For each shet in array("Sheet1", "Sheet2", "Sheet3"... )
		' ---------------------------------------------------
		Dim ind
		For ind = 2 To 5	'根据工作簿中Sheet的个数修改，Sheet2~Sheet5
			shet = "Sheet" & ind
 
			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("D:\CMSDB.xls")  '修改为对应Excel路径，注意后缀必须一样  
				 set xlsSheet = x1sApp.Workbooks(1).Worksheets(shet)   '指定要打开的sheet名称  
			Else  
				 HaveExcel = False  
			End If  
	 
			a  mdl,x1sApp,xlsWorkBook,xlsSheet  
			
			cnt = cnt + 1
		Next 
 
    MsgBox "生成数据表结构共计 " + CStr(cnt), vbOK + vbInformation, "表"  

	sub a(mdl,x1sApp,xlsWorkBook,xlsSheet)  
    
		dim rwIndex     
    dim table  
    dim col  
    dim rowCount
 
    rowCount = xlsSheet.usedRange.Rows.Count
 
    on error Resume Next  
 
    For rwIndex = 2 To rowCount   '指定要遍历的Excel行标  第1行是表头  
            With xlsSheet
                If .Cells(rwIndex, 2).Value = "" Then '如果遍历到第二列为空，则退出  
                   Exit For  
                End If  
                If .Cells(rwIndex, 3).Value = "" Then '如果遍历到第三列为空，则此行为表名  
                   set table = mdl.Tables.CreateNew     '创建表  
                    table.Name = .Cells(rwIndex , 1).Value '指定表名，第1列的值  
                    table.Code = .Cells(rwIndex , 2).Value   
                    table.Comment = .Cells(rwIndex , 1).Value '指定表注释，第一列的值  
                Else  
                   set col = table.Columns.CreateNew   '创建一列/字段  
                   'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"              
                   col.Name = .Cells(rwIndex, 1).Value   '指定列：字段名         
                   'MsgBox col.Name, vbOK + vbInformation, "列"  
                   col.Code = .Cells(rwIndex, 2).Value   '指定列：字段编码                          
                   col.DataType = .Cells(rwIndex, 3).Value '指定列：字段数据类型             
                     'MsgBox col.DataType, vbOK + vbInformation, "列类型"   
									 If .Cells(rwIndex, 4).Value = "" Then	 
											col.Comment = .Cells(rwIndex, 1).Value  
									 Else
											col.Comment = .Cells(rwIndex, 4).Value  '指定列：字段说明  
									 End If
                   if col.Code = "id" Then                   
                         col.Identity = true                  
                    End If
                    if col.Code = "ID" Then                   
                         col.Identity = true                  
                    End If
                    
                    if .Cells(rwIndex, 4).Value = "Primary Key" Then                   
                         col.Primary = true                  
                    End If

                    'If .Cells(rwIndex, 5).Value = "NOT NULL" Then                   
                    '    col.Mandatory =true                  
                    'End If
                End If    
            End With  

    Next  
    xlsWorkBook.Close
    x1sApp.Quit
    set x1sApp = nothing
    set xlsWorkBook = nothing

    Exit Sub  
	End sub

　　

上一篇：PowerDesigner导出数据表结构到Excel 一个表一个Sheet 带链接目录