excel2pdm
'
******************************************************************************
' * File: excel2pdm.txt
' * Title: pdm export to excel
' * Purpose: To export the tables and columns to Excel
' * Model: Physical Data Model
' * Objects: Table, Column, View
' * Author: ziyan
' * Created: 2012-05-03
' *Modifier: Hui Wanpeng 2014/07/04
' * Version: 1.0
' ******************************************************************************
Option Explicit
Dim md1 ' the current model
Set md1 = ActiveModel
If (md1 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.Workbooks.Open " E:/tmp/B超检查表.xls "
x1.Workbooks( 1 ).Worksheets( " Sheet1 " ).Activate
Else
HaveExcel = False
End If
process x1, md1
sub process(x1,md1)
dim rwIndex
dim tableName
dim colname
dim table
dim col
dim count
dim dType
dim nNull
' on error Resume Next
For rwIndex = 1 To 500 step 1
With x1.Workbooks( 1 ).Worksheets( " Sheet1 " )
If .Cells(rwIndex, 1 ).Value = "" Then
Exit For
End If
If .Cells(rwIndex, 3 ).Value = "" Then
set table = md1.Tables.CreateNew
table.Name = .Cells(rwIndex, 2 ).Value
table.Code = UCase (.Cells(rwIndex, 1 ).Value)
table.Comment = .Cells(rwIndex, 2 ).Value
count = count + 1
Else
colName = .Cells(rwIndex, 1 ).Value
set col = table.Columns.CreateNew
' MsgBox.Cells(rwIndex,1).Value
' MsgBox colName,vbOK+vbInformation,"列"
col.Code = Trim ( UCase (.Cells(rwIndex, 1 ).Value))
col.Name = Trim ( UCase ( .Cells(rwIndex, 1 ).Value))
col.Comment = Trim (.Cells(rwIndex, 2 ).Value)
dType = Trim ( UCase (.Cells(rwIndex, 3 ).Value))
' MsgBox Left(dType, 5)
If Left (dType, 5 ) = " CHAR( " Then
dType = Replace (dType, " CHAR " , " VARCHAR2 " )
ElseIf Left (dType, 5 ) = " CAHR( " Then
dType = Replace (dType, " CAHR " , " VARCHAR2 " )
End If
col.DataType = dType
nNull = Trim ( UCase (.Cells(rwIndex, 4 ).Value))
If nNull = " NOT NULL " then
col.Mandatory = " true "
End If
End If
End With
Next
MsgBox " 生成数据表结构共计 " + CStr (count), vbOK + vbInformation, " 表 "
x1.Workbooks.Close
Exit Sub
End Sub
' * File: excel2pdm.txt
' * Title: pdm export to excel
' * Purpose: To export the tables and columns to Excel
' * Model: Physical Data Model
' * Objects: Table, Column, View
' * Author: ziyan
' * Created: 2012-05-03
' *Modifier: Hui Wanpeng 2014/07/04
' * Version: 1.0
' ******************************************************************************
Option Explicit
Dim md1 ' the current model
Set md1 = ActiveModel
If (md1 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.Workbooks.Open " E:/tmp/B超检查表.xls "
x1.Workbooks( 1 ).Worksheets( " Sheet1 " ).Activate
Else
HaveExcel = False
End If
process x1, md1
sub process(x1,md1)
dim rwIndex
dim tableName
dim colname
dim table
dim col
dim count
dim dType
dim nNull
' on error Resume Next
For rwIndex = 1 To 500 step 1
With x1.Workbooks( 1 ).Worksheets( " Sheet1 " )
If .Cells(rwIndex, 1 ).Value = "" Then
Exit For
End If
If .Cells(rwIndex, 3 ).Value = "" Then
set table = md1.Tables.CreateNew
table.Name = .Cells(rwIndex, 2 ).Value
table.Code = UCase (.Cells(rwIndex, 1 ).Value)
table.Comment = .Cells(rwIndex, 2 ).Value
count = count + 1
Else
colName = .Cells(rwIndex, 1 ).Value
set col = table.Columns.CreateNew
' MsgBox.Cells(rwIndex,1).Value
' MsgBox colName,vbOK+vbInformation,"列"
col.Code = Trim ( UCase (.Cells(rwIndex, 1 ).Value))
col.Name = Trim ( UCase ( .Cells(rwIndex, 1 ).Value))
col.Comment = Trim (.Cells(rwIndex, 2 ).Value)
dType = Trim ( UCase (.Cells(rwIndex, 3 ).Value))
' MsgBox Left(dType, 5)
If Left (dType, 5 ) = " CHAR( " Then
dType = Replace (dType, " CHAR " , " VARCHAR2 " )
ElseIf Left (dType, 5 ) = " CAHR( " Then
dType = Replace (dType, " CAHR " , " VARCHAR2 " )
End If
col.DataType = dType
nNull = Trim ( UCase (.Cells(rwIndex, 4 ).Value))
If nNull = " NOT NULL " then
col.Mandatory = " true "
End If
End If
End With
Next
MsgBox " 生成数据表结构共计 " + CStr (count), vbOK + vbInformation, " 表 "
x1.Workbooks.Close
Exit Sub
End Sub