excel表结构通过vb导入到pdm里

来源:互联网 发布:gd单片机官网 编辑:程序博客网 时间:2024/05/20 20:21


Dim mdl ' thecurrent modelSet mdl =ActiveModelIf (mdl Is Nothing) Then    MsgBox "没有活动的模版"End If Dim HaveExcelDim RQRQ = vbYes'MsgBox("Is Excel Installed on your machine ?", vbYesNo +vbInformation, "Confirmation")If RQ = vbYes Then    HaveExcel = True    ' Open &Create Excel DocumentDim x1 'Set x1 =CreateObject("Excel.Application")x1.Workbooks.Open"C:\Users\zhfeng\Desktop\pdm.xlsx" '指定excel文档路径ElseHaveExcel =FalseEnd If call a(x1, mdl) sub a(x1, mdl)dim rwIndexdim tableNamedim colnamedim tabledim coldim count,total,sheet on error Resume Nextfor total = 1 to 100set sheet = nothing set sheet = x1.Workbooks(1).Worksheets("Sheet"+cstr(total))  With sheet '需要循环的sheet名称      if .cells(1,1).value = "" then      exit for   end if   set table = mdl.Tables.CreateNew '创建一个表实体table.Name =.cells(1,1).value '指定表名,如果在Excel文档里有,也可以 .Cells(rwIndex, 3).Value 这样指定table.comment =.cells(1,1).valuetable.Code =.cells(1,2).value'指定表名编码count = count +1For rwIndex = 3 To 1000 '指定要遍历的Excel行标,此处第一列为列名,古从第二行开始循环If.Cells(rwIndex, 1).Value = "" ThenExit ForEnd If set col =table.Columns.CreateNew '创建一列/字段 col.Name =.Cells(rwIndex, 1).Value '指定列名 col.Code =.Cells(rwIndex, 2).Value '指定列名编码 col.DataType =.Cells(rwIndex, 3).Value '指定列数据类型 col.Length =.Cells(rwIndex, 4).Value '指定字段长度 col.Precision =cint(.Cells(rwIndex, 5).Value) '指定字段长度 '指定主键If.Cells(rwIndex, 6).Value = "Y" Thencol.Primary =trueEnd If '指定列是否可空 true 为不可空If.Cells(rwIndex, 7).Value = "N" Thencol.Mandatory =trueEnd If col.Comment =.Cells(rwIndex, 8).Value '指定列说明NextEnd Withnextset mdl = NothingMsgBox "生成数据表结构共计 " + CStr(count), vbOK+ vbInformation, "表"  Exit SubEnd sub


0 0
原创粉丝点击