excel2pdm

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


你可能感兴趣的:(excel2pdm)