|
_I="I" '是否主键
CONST CELL_J="J" '是否可空
CONST CELL_K="K" '默认值
CONST str_iskey="Y"
DIM nb
'
' get the current active model
'
DIM mdl ' the current model
SET mdl = ActiveModel
IF (mdl IS NOTHING) THEN
MsgBox "没有选择一个Model"
END IF
DIM fldr
SET Fldr = ActiveDiagram.Parent
DIM isMerage '是否需要合并表名称单元格
DIM isMulite '是否不同的Package不同的sheet
DIM RQ
RQ = MsgBox ("是否不同的Package不同的sheet?", vbYesNo + vbInformation,"确认")
IF RQ= VbYes THEN
isMulite= TRUE
ELSE
isMulite= FALSE
END IF
' 创建新的Excel
DIM x1 '
SET x1 = CreateObject("Excel.Application")
x1.Workbooks.Add
x1.Visible = TRUE
ExportModelToExcel( fldr)
MsgBox "成功将 Models 导出到Excel中！"
'--------------------------------------------------------------------------------
'功能函数:将模型导出到Sheet页【 MODEL 】
'--------------------------------------------------------------------------------
PRIVATE FUNCTION ExportModelToExcel(folder)
'如果是每个package导出到不同的sheet页面，则采用folder的名称作为sheet页名称，否则使用"MODEL"作为sheet页名称
IF isMulite THEN
IF folder.Tables.count>0 THEN
AddExcelSheet(folder.name)
END IF
ELSE
AddExcelSheet("MODEL")
END IF
'写sheet页的第一行表头
WriteExcelModelHead
DIM nStart
DIM nEnd
DIM tabobj '定义数据表对象
nb=2
isMerage=TRUE
'开始循环处理所有的folder
FOR EACH tabobj IN folder.Tables
IF NOT tabobj.isShortcut THEN '快捷方式不处理
'合并表的单元格A、B、C
IF isMerage THEN '合并表的单元格A、B、C
nStart=nb '合并起始行
nEnd=nb+tabobj.Columns.count-1 '合并结束行
IF nStart<>nEnd THEN
'合并单元格
x1.Range(CELL_A+CSTR(nStart)+":"+CELL_A+CSTR(nEnd)).SELECT
x1.Selection.Merge
x1.Range(CELL_B+CSTR(nStart)+":"+CELL_B+CSTR(nEnd)).SELECT
x1.Selection.Merge
END IF
'将主题域、表名称、表注释填写到合并后单元格中
x1.Range(CELL_A+CSTR(nb)).Value = folder.name '主题域
x1.Range(CELL_B+CSTR(nb)).Value = Rtf2Ascii(tabobj.description) '表注释
END IF
'开始循环列兵输出信息
DIM colobj '定义列对象
FOR EACH colobj IN tabobj.Columns
'写表的信息
x1.Range(CELL_C+CSTR(nb)).Value = tabobj.code '表英文名称
x1.Range(CELL_D+CSTR(nb)).Value = tabobj.name '表英文名称
'写列的信息
x1.Range(CELL_E+CSTR(nb)).Value = colobj.code '列名
x1.Range(CELL_F+CSTR(nb)).Value = colobj.name '列中文名称
x1.Range(CELL_G+CSTR(nb)).Value = Rtf2Ascii(colobj.Description) '列注释
x1.Range(CELL_H+CSTR(nb)).Value = colobj.DataType '数据类型
'列是否主键，如果是主键，则输出 Y
IF colobj.primary THEN
x1.Range(CELL_I+CSTR(nb)).Value = "Y"
END IF
nb = nb+1 '行号加1
NEXT
END IF
NEXT
'对子包进行递归，如果不使用递归只能取到第一个模型图内的表
DIM subfolder
FOR EACH subfolder IN folder.Packages
ExportModelToExcel(subfolder)
NEXT
END FUNCTION
'--------------------------------------------------------------------------------
'功能函数:添加一个Sheet页
'--------------------------------------------------------------------------------
PRIVATE SUB AddExcelSheet(sheetname)
x1.Sheets.Add
x1.ActiveSheet.Name=sheetname
END SUB
'--------------------------------------------------------------------------------
'功能函数:写Excel的第一行信息
'--------------------------------------------------------------------------------
PRIVATE SUB WriteExcelModelHead()
x1.Range(CELL_A+"1").Value = "主题域"
x1.Range(CELL_B+"1").Value = "表注释"
x1.Range(CELL_C+"1").Value = "表英文名称"
x1.Range(CELL_D+"1").Value = "表中文名称"
x1.Range(CELL_E+"1").Value = "列 |