<rt id="bn8ez"></rt>
<label id="bn8ez"></label>
  • 

    • <span id="bn8ez"></span>
    

    <label id="bn8ez"><meter id="bn8ez"></meter></label>
    

    
    

    




    







												


        

    
	

    
	
    
		
    
			
				
    夢幻之旅
    
				
    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 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


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

    







    
	    
    




    





    


    

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


    

		    		
		
    
		
    			
		
		
		
		
    
		
    
		
		
    
		
    
			網站導航:
		
		
    
		
    
			


		
    	
		
    
			 
		
    
		
    
			
		
    
		
    
			
				
		
    		
	
    	

    



    

				

    




    







    
        
	



主站蜘蛛池模板：
亚洲成年轻人电影网站www|
花蝴蝶免费视频在线观看高清版
|
日日麻批免费40分钟无码|
久久www免费人成看片|
免费大香伊蕉在人线国产|
亚洲五月综合网色九月色|
人成免费在线视频|
国产精品亚洲综合专区片高清久久久|
亚洲精品色在线网站|
国产成人精品高清免费|
精品国产亚洲第一区二区三区
|
精品韩国亚洲av无码不卡区|
大学生高清一级毛片免费|
中中文字幕亚洲无线码|
日韩在线免费播放|
香蕉国产在线观看免费|
国产精品亚洲片在线观看不卡|
亚洲综合伊人制服丝袜美腿|
最近中文字幕完整免费视频ww
|
亚洲av中文无码乱人伦在线咪咕|
A国产一区二区免费入口|
国产精品亚洲一区二区三区在线|
亚洲区日韩精品中文字幕|
日韩视频在线免费|
国产vA免费精品高清在线观看|
国精无码欧精品亚洲一区
|
国产成人精品亚洲日本在线
|
亚洲国产亚洲片在线观看播放|
成年女人午夜毛片免费看|
亚洲永久网址在线观看|
亚洲国产成人a精品不卡在线|
免费久久人人爽人人爽av|
精品亚洲A∨无码一区二区三区|
一区二区3区免费视频|
亚洲av无码一区二区三区不卡|
182tv免费视视频线路一二三|
最新亚洲成av人免费看|
91短视频免费在线观看|
日韩色视频一区二区三区亚洲|
国产AV无码专区亚洲AWWW|
69精品免费视频|