亚洲一区视频在线播放,亚洲第一视频网站,国产精品亚洲A∨天堂不卡

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 With

MsgBox "生成數據表結構共計 " + CStr(count), vbOK+vbInformation, "表"

x1.Workbooks.Close

Exit Sub

End Sub

posted on 2014-07-06 21:06 HUIKK 閱讀(390) 評論(0) 編輯收藏所屬分類: VB/VBA/VBS

新用戶注冊刷新評論列表


只有注冊用戶登錄后才能發表評論。




網站導航: 博客園 IT新聞 Chat2DB C++博客博問管理
相關文章: excel2pdm vb 托盤 VBA 自定義函數 (原創) VBA 代碼的保護 (原創) VBA-Test

夢幻之旅

公告

常用鏈接

留言簿(21)

隨筆分類(644)

隨筆檔案(669)

文章檔案(6)

最新隨筆

積分與排名

最新評論

閱讀排行榜

評論排行榜