梦幻之旅

DEBUG - 天道酬勤

   :: 首页 :: 新随笔 :: 联系 :: 聚合  :: 管理 ::
  671 随笔 :: 6 文章 :: 256 评论 :: 0 Trackbacks
'******************************************************************************
'
* 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 NothingThen
  
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


posted on 2014-07-06 21:06 HUIKK 阅读(251) 评论(0)  编辑  收藏 所属分类: VB/VBA/VBS

只有注册用户登录后才能发表评论。


网站导航: