powerdesigner中可执行脚本代码(VB)

电玩女神 2024-04-20 08:11 86阅读 0赞

# powerdesigner中可执行脚本代码(VB) #

### 文章目录 ###

*  powerdesigner中可执行脚本代码(VB)
 *   *  1. 用于Physical Data Mode的脚本
     *   *  1.1 name转化comment
         *  1.2 comment转化为name
         *  1.3 name变成code
         *  1.4 将excel表格导入table中
         *  1.5 删除工程中所有table中的某个同一的属性
     *  2. 用于Object Oriented Model的脚本
     *   *  2.1 将Excel导入class中

## 1. 用于Physical Data Mode的脚本 ##

*参考地址：[https://blog.csdn.net/chao\_1990/article/details/52620206][https_blog.csdn.net_chao_1990_article_details_52620206]*

### 1.1 name转化comment ###

Option   Explicit   
    ValidationMode   =   True   
    InteractiveMode   =   im_Batch  
       
    Dim   mdl   '   the   current   model  
    '   get   the   current   active   model   
    Set   mdl   =   ActiveModel   
    If   (mdl   Is   Nothing)   Then   
          MsgBox   "There   is   no   current   Model "   
    ElseIf   Not   mdl.IsKindOf(PdPDM.cls_Model)   Then   
          MsgBox   "The   current   model   is   not   an   Physical   Data   model. "   
    Else   
          ProcessFolder   mdl   
    End   If  
    '   This   routine   copy   name   into   comment   for   each   table,   each   column   and   each   view   
    '   of   the   current   folder   
    Private   sub   ProcessFolder(folder)   
          Dim   Tab   'running     table   
          for   each   Tab   in   folder.tables   
                if   not   tab.isShortcut   then   
                      tab.comment   =   tab.name   
                      Dim   col   '   running   column   
                      for   each   col   in   tab.columns   
                            col.comment=   col.name   
                      next   
                end   if   
          next  
          Dim   view   'running   view   
          for   each   view   in   folder.Views   
                if   not   view.isShortcut   then   
                      view.comment   =   view.name   
                end   if   
          next  
       
          '   go   into   the   sub-packages   
          Dim   f   '   running   folder   
          For   Each   f   In   folder.Packages   
                if   not   f.IsShortcut   then   
                      ProcessFolder   f   
                end   if   
          Next   
    end   sub

### 1.2 comment转化为name ###

Option   Explicit     
    ValidationMode   =   True     
    InteractiveMode   =   im_Batch    
        
    Dim   mdl   '   the   current   model    
        
    '   get   the   current   active   model     
    Set   mdl   =   ActiveModel     
    If   (mdl   Is   Nothing)   Then     
          MsgBox   "There   is   no   current   Model "     
    ElseIf   Not   mdl.IsKindOf(PdPDM.cls_Model)   Then     
          MsgBox   "The   current   model   is   not   an   Physical   Data   model. "     
    Else     
          ProcessFolder   mdl     
    End   If    
        
    Private   sub   ProcessFolder(folder)     
    On Error Resume Next    
          Dim   Tab   'running     table     
          for   each   Tab   in   folder.tables     
                if   not   tab.isShortcut   then     
                      tab.name   =   tab.comment    
                      Dim   col   '   running   column     
                      for   each   col   in   tab.columns     
                      if col.comment="" then    
                      else    
                            col.name=   col.comment     
                      end if    
                      next     
                end   if     
          next    
        
          Dim   view   'running   view     
          for   each   view   in   folder.Views     
                if   not   view.isShortcut   then     
                      view.name   =   view.comment     
                end   if     
          next    
        
          '   go   into   the   sub-packages     
          Dim   f   '   running   folder     
          For   Each   f   In   folder.Packages     
                if   not   f.IsShortcut   then     
                      ProcessFolder   f     
                end   if     
          Next     
    end   sub

### 1.3 name变成code ###

Option   Explicit   
    ValidationMode   =   True   
    InteractiveMode   =   im_Batch  
      
    Dim   mdl   '   the   current   model  
      
    '   get   the   current   active   model   
    Set   mdl   =   ActiveModel   
    If   (mdl   Is   Nothing)   Then   
          MsgBox   "There   is   no   current   Model "   
    ElseIf   Not   mdl.IsKindOf(PdPDM.cls_Model)   Then   
          MsgBox   "The   current   model   is   not   an   Physical   Data   model. "   
    Else   
          ProcessFolder   mdl   
    End   If  
      
    Private   sub   ProcessFolder(folder)   
    On Error Resume Next  
          Dim   Tab   'running     table   
          for   each   Tab   in   folder.tables   
                if   not   tab.isShortcut   then   
                      tab.name   =   tab.code  
                      Dim   col   '   running   column   
                      for   each   col   in   tab.columns   
                      if col.code="" then  
                      else  
                            col.name=   col.code   
                      end if  
                      next   
                end   if   
          next  
      
          Dim   view   'running   view   
          for   each   view   in   folder.Views   
                if   not   view.isShortcut   then   
                      view.name   =   view.code   
                end   if   
          next  
      
          '   go   into   the   sub-packages   
          Dim   f   '   running   folder   
          For   Each   f   In   folder.Packages   
                if   not   f.IsShortcut   then   
                      ProcessFolder   f   
                end   if   
          Next   
    end   sub

### 1.4 将excel表格导入table中 ###

*参考地址:[https://blog.csdn.net/royzhang7/article/details/41118145][https_blog.csdn.net_royzhang7_article_details_41118145]*

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  '
       Set x1 = CreateObject("Excel.Application")
       x1.Workbooks.Open "E:\test.xls"   '指定excel文档路径
       x1.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
     
    For rwIndex = 2 To 1000   '指定要遍历的Excel行标  由于第1行是表头，从第2行开始
            With x1.Workbooks(1).Worksheets("Sheet1")
                If .Cells(rwIndex, 1).Value = "" Then '如果遍历到第一列为空，则退出
                   Exit For
                End If
                If .Cells(rwIndex, 3).Value = "" Then '如果遍历到第三列为空，则此行为表名
                   set table = mdl.Tables.CreateNew     '创建表
                    table.Name = .Cells(rwIndex , 2).Value '指定表名，第一列的值
                    table.Code = .Cells(rwIndex , 1).Value 
                    table.Comment = .Cells(rwIndex , 2).Value '指定表注释，第二列的值
                    count = count + 1  
                Else
                   set col = table.Columns.CreateNew   '创建一列/字段
                   'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"            
                      col.Name = .Cells(rwIndex, 1).Value   '指定列名       
                   'MsgBox col.Name, vbOK + vbInformation, "列"
                   col.Code = .Cells(rwIndex, 2).Value   '指定列名                        
                   col.DataType = .Cells(rwIndex, 4).Value '指定列数据类型           
                     'MsgBox col.DataType, vbOK + vbInformation, "列类型"               
                   col.Comment = .Cells(rwIndex, 3).Value  '指定列说明
                End If      
            End With
    Next
    MsgBox "生成数据表结构共计 " + CStr(count), vbOK + vbInformation, "表"
     
    Exit Sub
    End sub

对应的excel表格格式为:  
![在这里插入图片描述][20190920105415502.png]

### 1.5 删除工程中所有table中的某个同一的属性 ###

Option   Explicit   
    ValidationMode   =   True   
    InteractiveMode   =   im_Batch  
       
    Dim   mdl   '   the   current   model  
    '   get   the   current   active   model   
    Set   mdl   =   ActiveModel   
    If   (mdl   Is   Nothing)   Then   
          MsgBox   "There   is   no   current   Model "   
    ElseIf   Not   mdl.IsKindOf(PdPDM.cls_Model)   Then   
          MsgBox   "The   current   model   is   not   an   Physical   Data   model. "   
    Else   
          ProcessFolder   mdl   
    End   If  
    '   This   routine   copy   name   into   comment   for   each   table,   each   column   and   each   view   
    '   of   the   current   folder   
    Private   sub   ProcessFolder(folder)   
          Dim   Tab   'running     table   
          for   each   Tab   in   folder.tables   
                if   not   tab.isShortcut   then   
                       Dim   col   '   running   column   
                      for   each   col   in   tab.columns   
                            if col.code="对应的code名称" then                    
                            col.delete 
                            end if
                      next   
                end   if   
          next  
          '   go   into   the   sub-packages   
          Dim   f   '   running   folder   
          For   Each   f   In   folder.Packages   
                if   not   f.IsShortcut   then 
                ProcessFolder f
                end   if   
          Next   
    end   sub

## 2. 用于Object Oriented Model的脚本 ##

### 2.1 将Excel导入class中 ###

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  '
       Set x1 = CreateObject("Excel.Application")
       x1.Workbooks.Open "E:\实体类测试.xls"   '指定excel文档路径
       x1.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 anno
    dim count
    on error Resume Next
     
    For rwIndex = 2 To 1000   '指定要遍历的Excel行标  由于第1行是表头，从第2行开始
            With x1.Workbooks(1).Worksheets("Sheet1")
                If .Cells(rwIndex, 1).Value = "" Then '如果遍历到第一列为空，则退出
                   Exit For
                End If
                If .Cells(rwIndex, 3).Value = "" Then '如果遍历到第三列为空，则此行为表名
                   set table = mdl.Classes.CreateNew     '创建表
                    table.Name = .Cells(rwIndex , 2).Value '指定表名，第一列的值
                    table.Code = .Cells(rwIndex , 1).Value 
                    table.Comment = .Cells(rwIndex , 2).Value '指定表注释，第二列的值
                    count = count + 1  
                Else
                   set col = table.Attributes.CreateNew   '创建一列/字段
                   'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"            
                      col.Name = .Cells(rwIndex, 1).Value   '指定列名       
                   'MsgBox col.Name, vbOK + vbInformation, "列"
                   col.Code = .Cells(rwIndex, 2).Value   '指定列名                        
                   col.DataType = .Cells(rwIndex, 3).Value '指定列数据类型           
                     'MsgBox col.DataType, vbOK + vbInformation, "列类型"               
                   col.Comment = .Cells(rwIndex, 1).Value  '指定列说明
                End If    
                If .Cells(rwIndex, 4).Value <> "" Then 
                set anno = table.Annotations.CreateNew  '创建类的注解
                anno.Name = .Cells(rwIndex, 4) '指定注解名称
                    If .Cells(rwIndex, 5).Value <> "" Then
                    anno.Text = .Cells(rwIndex, 5) '指定注解内容
                    End If
                End If  
            End With
    Next
    MsgBox "生成类共计 " + CStr(count), vbOK + vbInformation, "表"
     
    Exit Sub
    End sub

对应的Excel表格格式为  
![在这里插入图片描述][20190920105437262.png]

[https_blog.csdn.net_chao_1990_article_details_52620206]: https://blog.csdn.net/chao_1990/article/details/52620206
[https_blog.csdn.net_royzhang7_article_details_41118145]: https://blog.csdn.net/royzhang7/article/details/41118145
[20190920105415502.png]: https://image.dandelioncloud.cn/pgy_files/images/2024/04/18/ee0103c0498f4917bcdee56c86ae9408.png
[20190920105437262.png]: https://image.dandelioncloud.cn/pgy_files/images/2024/04/18/4d29758eac5b4b2ba8701d9e31d57ea2.png