power desinger vb 脚本

Option Explicit
   ValidationMode = True
   InteractiveMode = im_Batch
 Dim mdl
 Set mdl = ActiveModel
  If(mdl Is Nothing) Then 
  MsgBox " there is no current model"
  ElseIf  Not mdl.IsKindOf(PdPDM.cls_Model) Then
  MsgBox " there is not an physical data model"
  Else ProcessFolder mdl
  End If
  
  Private sub ProcessFolder(folder)
   Dim Tab 
   for each Tab in folder.tables
      Dim col 
      for each col in tab.columns
         If col.DataType="tinyint(1)" then
         col.DataType="int(1)"
         End If
         next
         
       next
End sub

 

Option Explicit
   ValidationMode = True
   InteractiveMode = im_Batch
 Dim mdl
 Set mdl = ActiveModel
  If(mdl Is Nothing) Then 
  MsgBox " there is no current model"
  ElseIf  Not mdl.IsKindOf(PdPDM.cls_Model) Then
  MsgBox " there is not an physical data model"
  Else ProcessFolder mdl
  End If
  
  Private sub ProcessFolder(folder)
   Dim Tab 
   for each Tab in folder.tables
      
         If table.code="" then
         table.code=""
         End If
        
         
       next
End sub

 

Option Explicit

Dim mdl ' the current model
Set mdl = ActiveModel
If (mdl 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 '
Dim x2
Set x1 = CreateObject("Excel.Application")
Set x2 = CreateObject("Excel.Application")
x2.Workbooks.Open "D:\VSSLocal\ONEBOSS\04 基本设计\03 DB设计\02 表定义\公共字段.xls"
x1.Workbooks.Open "D:\excel\current.xls" '指定excel文档路径
x1.Workbooks(1).Worksheets("Sheet1").Activate '指定要打开的sheet名称
x2.Workbooks(1).Worksheets("Sheet1").Activate '指定要打开的sheet名称
Else
HaveExcel = False
End If

a x1, mdl

sub a(x1, mdl)
dim rwIndex 
dim tableName
dim colname
dim table
dim col
dim count

on error Resume Next

set table = mdl.Tables.CreateNew '创建一个表实体

For rwIndex = 15 To 100 '指定要遍历的Excel行标 由于第1行是表头，从第2行开始
With x1.Workbooks(1).Worksheets("Sheet1")
If .Cells(rwIndex, 2).Value = "" Then
Exit For
End If
 table.Name = .Cells(4, 3).Value '指定表名，如果在Excel文档里有，也可以 .Cells(rwIndex, 3).Value 这样指定
 table.Code = .Cells(4, 3).Value '指定表名

set col = table.Columns.CreateNew '创建一列/字段
'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"
If .Cells(rwIndex, 3).Value = "" Then
col.Name = .Cells(rwIndex, 2).Value '指定列名
Else 
col.Name = .Cells(rwIndex,3).Value
End If
'MsgBox col.Name, vbOK + vbInformation, "列"
col.Code = .Cells(rwIndex, 2).Value '指定列名

If .Cells(rwIndex,5).text <> "" Then	
    col.DataType=LCase(.Cells(rwIndex,4).Value)+"(" + .Cells(rwIndex, 5).text + ")"
  Else 
	col.DataType=LCase(.Cells(rwIndex,4).Value)
End If
If .Cells(rwIndex,10).Value <>"" Then
   col.Comment = "("+.Cells(rwIndex,3)+") 说明："+.Cells(rwIndex, 10).Value '指定列说明
 Else col.Comment=.Cells(rwIndex,3)
  End If
If .Cells(rwIndex,8)<> "" Then
	col.DefaultValue=.Cells(rwIndex,8)
End If
If .Cells(rwIndex, 7).Value = "N" Then
col.Mandatory = true '指定列是否可空 true 为不可空 
End If
If  .Cells(rwIndex, 6).Value = "PK" or .Cells(rwIndex,6).Value="Key" or .Cells(rwIndex,6).Value="KEY"  Then
col.Primary = true '指定主键
End If
End With
Next

For rwIndex= 1 To 13
With x2.Workbooks(1).Worksheets("Sheet1")
If .Cells(rwIndex, 1).Value = "" Then
Exit For
End If
set col = table.Columns.CreateNew
If .Cells(rwIndex, 2).Value = "" Then
col.Name = .Cells(rwIndex,1).Value '指定列名
Else 
col.Name = .Cells(rwIndex,2).Value
End If
col.Code = .Cells(rwIndex, 1).Value '指定列名
If .Cells(rwIndex,4).text <> "" Then	
    col.DataType=LCase(.Cells(rwIndex,3).Value)+"(" + .Cells(rwIndex, 4).text + ")"
  Else 
	col.DataType=LCase(.Cells(rwIndex,3).Value)
End If
If .Cells(rwIndex,9).Value <>"" Then
   col.Comment = "("+.Cells(rwIndex,2).Value+") 说明："+.Cells(rwIndex, 9).Value '指定列说明
 Else col.Comment=.Cells(rwIndex,2).Value
  End If  
If .Cells(rwIndex,7).Value <> "" Then
	col.DefaultValue=.Cells(rwIndex,7).text
End If
End With
Next

MsgBox "生成数据表结构共计 " + CStr(count), vbOK + vbInformation, "表"

Exit Sub
End sub