PDM与Excel利用VB脚本进行互导(二)
n("F:\model\model_import.xlsx")
xlApp.Visible = TRUE
output "开始从Excel创建模型"
Create_From_Excel(xlBook)
output "模型创建完成，开始关闭Excel"
SET xlBook=NOTHING
xlApp.Quit
SET xlApp=NOTHING
END IF
PRIVATE SUB Create_From_Excel(xlBook)
DIM xlsheet
DIM rowcount
dim pkg
FOR EACH xlsheet IN xlBook.WORKSHEETS
rowcount = xlsheet.UsedRange.Cells.Rows.Count
output "本Excel["+xlsheet.name+"]共有行数为:"+CSTR(rowcount)
IF rowcount>1 THEN
SET pkg = CreateOrReplacePackageByName( xlsheet.name , mdl)
Create_Model_From_Excel xlsheet,pkg
SET xlsheet=NOTHING
END IF
NEXT
END SUB
'--------------------------------------------------------------------------------
'功能函数
'--------------------------------------------------------------------------------
PRIVATE SUB Create_Model_From_Excel(xlsheet,package)
DIM Tab '定义数据表对象
DIM col
DIM tabcode
DIM tabcode1
DIM i
DIM col_code
FOR i=2 TO xlsheet.UsedRange.Cells.Rows.Count
'判断是否需要创建新表对象
tabcode1 = xlsheet.Range(CELL_C+CSTR(i)).Value
IF tabcode1<>"" and tabcode<>tabcode1 THEN
SET Tab=NOTHING
tabcode=tabcode1
IF tabcode<>"" THEN
'判断表是否存在，如果不存在则创建，存在则直接返回表对象
SET tab = CreateOrReplaceTableByCode(tabcode,package)
'将表的所有列删除,如果需要重新创建表的列
IF isclear_columns THEN
DeleteTableColumns(tab)
END IF
'更新表的属性
Tab.code=xlsheet.Range(CELL_C+CSTR(i)).Value
Tab.name=xlsheet.Range(CELL_D+CSTR(i)).Value
Tab.comment=xlsheet.Range(CELL_D+CSTR(i)).Value
Tab.Description=xlsheet.Range(CELL_B+CSTR(i)).Value '注释
'Tab.owne
r=FindUserByName(str_username)
output "创建表模型OK:"+Tab.code+"——"+Tab.name
END IF
END IF
IF NOT(Tab IS NOTHING) THEN '创建表的列
col_code=xlsheet.Range(CELL_E+CSTR(i)).Value '列代码
'判断是否已经存在列,不存在则创建
SET col = CreateOrReplaceColumnByCode(col_code,Tab)
'设置列属性
col.code=xlsheet.Range(CELL_E+CSTR(i)).Value '列代码
col.name=xlsheet.Range(CELL_F+CSTR(i)).Value '列名称
col.comment=xlsheet.Range(CELL_F+CSTR(i)).Value '列注释
col.Description=xlsheet.Range(CELL_G+CSTR(i)).Value '列注释
col.DataType=xlsheet.Range(CELL_H+CSTR(i)).Value '列数据类型
'列是否主键，如果是主键，则输出 Y
IF CSTR(xlsheet.Range(CELL_I+CSTR(i)).Value)=str_iskey THEN
col.primary= TRUE
END IF
output "更新表模型的列OK:"+Tab.code+"——"+col.code+"--"+col.name
END IF
NEXT
END SUB
'--------------------------------------------------------------------------------
'功能函数
'--------------------------------------------------------------------------------
PRIVATE FUNCTION CreateOrReplacePackageByName(name,model)
DIM pkg 'Table 对象
SET pkg = FindPackageByName(name,model)
IF pkg IS NOTHING THEN
SET pkg = model.Packages.CreateNew()
pkg.SetNameAndCode name, name
pkg.PhysicalDiagrams.Item(0).SetNameAndCode name, name
END IF
SET CreateOrReplacePackageByName = pkg
END FUNCTION
PRIVATE FUNCTION CreateOrReplaceTableByCode(code,package)
DIM tab 'Table 对象
SET tab = FindTableByCode(code,package)
IF tab IS NOTHING THEN
SET tab = package.Tables.CreateNew()
tab.SetNameAndCode code, code
END IF
SET CreateOrReplaceTableByCode = tab
END FUNCTION
PRIVAT