| ページ一覧 | ブログ | twitter |  書式 | 書式(表) |

MyMemoWiki

「Visio ER図の情報を取得する」の版間の差分

提供: MyMemoWiki
ナビゲーションに移動 検索に移動
(ページの作成:「==Visio ER図の情報を取得する== [Visio][VBA] *http://msdn.microsoft.com/ja-jp/library/cc377254.aspx ===モジュール=== VisioのER図をCSV出力する…」)
 
 
(同じ利用者による、間の3版が非表示)
1行目: 1行目:
==Visio ER図の情報を取得する==
+
==[[Visio ER図の情報を取得する]]==
[Visio][VBA]
+
[[Visio]] | [[VBA]] |
  
 
*http://msdn.microsoft.com/ja-jp/library/cc377254.aspx
 
*http://msdn.microsoft.com/ja-jp/library/cc377254.aspx
  
 
===モジュール===
 
===モジュール===
VisioのER図をCSV出力するマクロ
+
[[Visio]]のER図をCSV出力するマクロ
{{ref MakeVisioEntityList.zip}}
+
{{ref Make[[Visio]]EntityList.zip}}
<blockquote>メタ情報が取得しかたがわからない(そもそもできる?)。。。</blockquote>
+
&lt;blockquote&gt;メタ情報が取得しかたがわからない(そもそもできる?)。。。&lt;/blockquote&gt;
 
   
 
   
 
  'ログ出力の抑制
 
  'ログ出力の抑制
 
  Private Const IS_LOGGING As Boolean = True
 
  Private Const IS_LOGGING As Boolean = True
 
   
 
   
  '除外するVisioシート名(一部一致をカンマ区切り)
+
  '除外する[[Visio]]シート名(一部一致をカンマ区切り)
  Private Const EXCEPT_SHEET_KEYWORD As String = "背景"
+
  Private Const EXCEPT_SHEET_KEYWO[[R]]D As String = "背景"
 
   
 
   
 
  'エンティティを識別するためのマスターシェイプ名
 
  'エンティティを識別するためのマスターシェイプ名
  Private Const MASTER_SHAPE_ENTITY_NAME_U As String = "Entity"
+
  Private Const MASTE[[R]]_SHAPE_ENTITY_NAME_U As String = "Entity"
 
   
 
   
 
  '
 
  '
32行目: 32行目:
 
     Set entityDict = CreateObject("Scripting.Dictionary")
 
     Set entityDict = CreateObject("Scripting.Dictionary")
 
      
 
      
     'Visioドキュメントのページ単位で処理
+
     '[[Visio]]ドキュメントのページ単位で処理
 
     Set docPages = Application.ActiveDocument.Pages
 
     Set docPages = Application.ActiveDocument.Pages
 
     docPageCnt = docPages.Count
 
     docPageCnt = docPages.Count
38行目: 38行目:
 
     For i = 1 To docPageCnt
 
     For i = 1 To docPageCnt
 
         'Entity辞書のクリア
 
         'Entity辞書のクリア
         Call entityDict.RemoveAll
+
         Call entityDict.[[R]]emoveAll
 
          
 
          
 
         Set docPage = docPages.Item(i)
 
         Set docPage = docPages.Item(i)
57行目: 57行目:
 
  ' シートごとの処理
 
  ' シートごとの処理
 
  '
 
  '
  Private Sub ParsePage(ByRef docPage As Page, ByRef entityDict As Object)
+
  Private Sub ParsePage(By[[R]]ef docPage As Page, By[[R]]ef entityDict As Object)
 
      
 
      
 
     Dim docShapes      As Shapes
 
     Dim docShapes      As Shapes
71行目: 71行目:
 
          
 
          
 
         Select Case True
 
         Select Case True
         Case InStr(1, docShapeNameU, MASTER_SHAPE_ENTITY_NAME_U) = 1
+
         Case InStr(1, docShapeNameU, MASTE[[R]]_SHAPE_ENTITY_NAME_U) = 1
 
             ' テーブル、列、データ型
 
             ' テーブル、列、データ型
 
             Call ProcEntity(docShapes(i), entityDict)
 
             Call ProcEntity(docShapes(i), entityDict)
83行目: 83行目:
 
  ' エンティティ処理
 
  ' エンティティ処理
 
  '
 
  '
  Private Sub ProcEntity(ByRef entityShape As Shape, ByRef entityDict As Object)
+
  Private Sub ProcEntity(By[[R]]ef entityShape As Shape, By[[R]]ef entityDict As Object)
 
     Dim partsShapes    As Shapes
 
     Dim partsShapes    As Shapes
 
     Dim partsShape      As Shape
 
     Dim partsShape      As Shape
92行目: 92行目:
 
     Dim ent            As Entity
 
     Dim ent            As Entity
 
     Dim col            As Column
 
     Dim col            As Column
     Dim rareRow()      As String
+
     Dim rare[[R]]ow()      As String
     Dim splitedRow()    As String
+
     Dim splited[[R]]ow()    As String
 
      
 
      
 
     Set partsShapes = entityShape.Shapes
 
     Set partsShapes = entityShape.Shapes
118行目: 118行目:
 
         Case 2
 
         Case 2
 
             '2:列情報
 
             '2:列情報
             rareRow = Split(partsShape.Text, vbLf)
+
             rare[[R]]ow = Split(partsShape.Text, vbLf)
             For j = LBound(rareRow) To UBound(rareRow)
+
             For j = LBound(rare[[R]]ow) To UBound(rare[[R]]ow)
                 splitedRow = SplitRow(rareRow(j))
+
                 splited[[R]]ow = Split[[R]]ow(rare[[R]]ow(j))
 
                  
 
                  
 
                 Set col = New Column
 
                 Set col = New Column
                 col.Name = splitedRow(0)
+
                 col.Name = splited[[R]]ow(0)
                 col.DataType = splitedRow(1)
+
                 col.DataType = splited[[R]]ow(1)
 
                  
 
                  
                 If Trim(col.Name) <> "" Then
+
                 If Trim(col.Name) &lt;&gt; "" Then
 
                     Call ent.AddColumn(col)
 
                     Call ent.AddColumn(col)
 
                 End If
 
                 End If
138行目: 138行目:
 
  ' 列名とデータ型を分ける
 
  ' 列名とデータ型を分ける
 
  '
 
  '
  Private Function SplitRow(ByRef row As String) As String()
+
  Private Function Split[[R]]ow(By[[R]]ef row As String) As String()
     Const COL_SEP_CHAR As String = vbTab
+
     Const COL_SEP_CHA[[R]] As String = vbTab
 
     Dim sepPos          As Integer
 
     Dim sepPos          As Integer
 
     Dim i              As Integer
 
     Dim i              As Integer
149行目: 149行目:
 
     ret(1) = ""
 
     ret(1) = ""
 
      
 
      
     If Trim(row) <> "" Then
+
     If Trim(row) &lt;&gt; "" Then
         tmp = Split(row, COL_SEP_CHAR)
+
         tmp = Split(row, COL_SEP_CHA[[R]])
 
          
 
          
         If UBound(tmp) > 0 Then
+
         If UBound(tmp) &gt; 0 Then
 
             ret(0) = Trim(tmp(0))
 
             ret(0) = Trim(tmp(0))
 
             ret(1) = Trim(tmp(1))
 
             ret(1) = Trim(tmp(1))
159行目: 159行目:
 
         End If
 
         End If
 
     End If
 
     End If
     SplitRow = ret
+
     Split[[R]]ow = ret
 
   
 
   
 
  End Function
 
  End Function
170行目: 170行目:
 
     Dim i          As Integer
 
     Dim i          As Integer
 
      
 
      
     keywords = Split(EXCEPT_SHEET_KEYWORD, ",")
+
     keywords = Split(EXCEPT_SHEET_KEYWO[[R]]D, ",")
 
   
 
   
 
     For i = LBound(keywords) To UBound(keywords)
 
     For i = LBound(keywords) To UBound(keywords)
         ret = InStr(sheetName, keywords(i)) > 0
+
         ret = InStr(sheetName, keywords(i)) &gt; 0
 
         If ret Then
 
         If ret Then
 
             Exit For
 
             Exit For
236行目: 236行目:
 
     Columns = mColumns
 
     Columns = mColumns
 
  End Property
 
  End Property
  Public Property Let Columns(ByRef newColumns() As Column)
+
  Public Property Let Columns(By[[R]]ef newColumns() As Column)
 
     Set mColumns = newColumns
 
     Set mColumns = newColumns
 
  End Property
 
  End Property
 
   
 
   
 
   
 
   
  Public Sub AddColumn(ByRef col As Column)
+
  Public Sub AddColumn(By[[R]]ef col As Column)
 
   
 
   
 
      
 
      
     ReDim Preserve mColumns(mColumnCnt)
+
     [[R]]eDim Preserve mColumns(mColumnCnt)
 
      
 
      
 
     Set mColumns(mColumnCnt) = col
 
     Set mColumns(mColumnCnt) = col

2020年2月16日 (日) 04:33時点における最新版

Visio ER図の情報を取得する

Visio | VBA |

モジュール

VisioのER図をCSV出力するマクロ {{ref MakeVisioEntityList.zip}} <blockquote>メタ情報が取得しかたがわからない(そもそもできる?)。。。</blockquote>

'ログ出力の抑制
Private Const IS_LOGGING As Boolean = True

'除外するVisioシート名(一部一致をカンマ区切り)
Private Const EXCEPT_SHEET_KEYWORD As String = "背景"

'エンティティを識別するためのマスターシェイプ名
Private Const MASTER_SHAPE_ENTITY_NAME_U As String = "Entity"

'
' 主処理
'
Sub main()
    Dim docPages    As Pages
    Dim docPage     As Page
    Dim docPageCnt  As Integer
    Dim i           As Integer
    
    
    Dim entityDict  As Object   'Entityを保持するMap
    
    Set entityDict = CreateObject("Scripting.Dictionary")
    
    'Visioドキュメントのページ単位で処理
    Set docPages = Application.ActiveDocument.Pages
    docPageCnt = docPages.Count
    
    For i = 1 To docPageCnt
        'Entity辞書のクリア
        Call entityDict.RemoveAll
        
        Set docPage = docPages.Item(i)
        If Not IsExceptSheet(docPage.Name) Then
            Call ParsePage(docPage, entityDict)
        End If
        
        ' TODO
        '
        ' ここで、entityDict に 結果 {テーブル名:テーブルオブジェクト}
        ' が格納されるので、なんらかの処理(ファイル出力など)を行う
        '
        '
        
    Next
End Sub
'
' シートごとの処理
'
Private Sub ParsePage(ByRef docPage As Page, ByRef entityDict As Object)
    
    Dim docShapes       As Shapes
    Dim docShapeCnt     As Integer
    Dim i               As Integer
    Dim docShapeNameU   As String
    
    Set docShapes = docPage.Shapes
    docShapeCnt = docShapes.Count
    
    For i = 1 To docShapeCnt
        docShapeNameU = docShapes(i).NameU
        
        Select Case True
        Case InStr(1, docShapeNameU, MASTER_SHAPE_ENTITY_NAME_U) = 1
            ' テーブル、列、データ型
            Call ProcEntity(docShapes(i), entityDict)
        Case Else
            'Debug.Print docShapeNameU
        End Select
        
    Next
End Sub
'
' エンティティ処理
'
Private Sub ProcEntity(ByRef entityShape As Shape, ByRef entityDict As Object)
    Dim partsShapes     As Shapes
    Dim partsShape      As Shape
    Dim explainShape    As Shape
    Dim partsShapeCnt   As Integer
    Dim i               As Integer
    Dim j               As Integer
    Dim ent             As Entity
    Dim col             As Column
    Dim rareRow()       As String
    Dim splitedRow()    As String
    
    Set partsShapes = entityShape.Shapes
    partsShapeCnt = partsShapes.Count
    
    For i = 1 To partsShapeCnt
    
        Set partsShape = partsShapes(i)
        Select Case i
        Case 1
            ' テーブル名
            Set ent = New Entity
            ent.Name = partsShape.Text
            
            If entityDict.Exists(ent.Name) Then
                'TODO Duplicated
                Call MsgBox("重複" + ent.Name)
            Else
                Call entityDict.Add(ent.Name, ent)
            End If
            
            Call Logging(vbCrLf & ent.Name)
            
        Case 2
            '2:列情報
            rareRow = Split(partsShape.Text, vbLf)
            For j = LBound(rareRow) To UBound(rareRow)
                splitedRow = SplitRow(rareRow(j))
                
                Set col = New Column
                col.Name = splitedRow(0)
                col.DataType = splitedRow(1)
                
                If Trim(col.Name) <> "" Then
                    Call ent.AddColumn(col)
                End If
                Call Logging(vbTab & col.Name & " " & col.DataType)
            Next
        End Select
    Next
    
End Sub
'
' 列名とデータ型を分ける
'
Private Function SplitRow(ByRef row As String) As String()
    Const COL_SEP_CHAR As String = vbTab
    Dim sepPos          As Integer
    Dim i               As Integer
    Dim c               As String
    Dim ret(0 To 1)     As String
    Dim tmp()           As String
    
    ret(0) = ""
    ret(1) = ""
    
    If Trim(row) <> "" Then
        tmp = Split(row, COL_SEP_CHAR)
        
        If UBound(tmp) > 0 Then
            ret(0) = Trim(tmp(0))
            ret(1) = Trim(tmp(1))
        Else
            ret(0) = Trim(row)
        End If
    End If
    SplitRow = ret

End Function
'
' 除外シートのチェック
'
Private Function IsExceptSheet(sheetName As String) As Boolean
    Dim keywords()  As String
    Dim ret         As Boolean
    Dim i           As Integer
    
    keywords = Split(EXCEPT_SHEET_KEYWORD, ",")

    For i = LBound(keywords) To UBound(keywords)
        ret = InStr(sheetName, keywords(i)) > 0
        If ret Then
            Exit For
        End If
    Next

    IsExceptSheet = ret
End Function
'
' ログ
'
Private Sub Logging(log As String)
    If IS_LOGGING Then
        Debug.Print log
    End If
End Sub

クラス

Column

Private mName       As String
Private mDataType   As String
Private mExplain    As String


Public Property Get Name() As String
    Name = mName
End Property

Public Property Let Name(ByVal newName As String)
    mName = newName
End Property

Public Property Get DataType() As String
    DataType = mDataType
End Property

Public Property Let DataType(ByVal newDataType As String)
    mDataType = newDataType
End Property

Public Property Get Explain() As String
    Explain = mExplain
End Property

Public Property Let Explain(ByVal newExplain As String)
    mExplain = newExplain
End Property

Entity

Private mName       As String
Private mColumns()  As Column
Private mColumnCnt  As Integer


Public Property Get Name() As String
    Name = mName
End Property

Public Property Let Name(ByVal newName As String)
    mName = newName
End Property

Public Property Get Columns() As Column()
    Columns = mColumns
End Property
Public Property Let Columns(ByRef newColumns() As Column)
    Set mColumns = newColumns
End Property


Public Sub AddColumn(ByRef col As Column)

    
    ReDim Preserve mColumns(mColumnCnt)
    
    Set mColumns(mColumnCnt) = col

    mColumnCnt = mColumnCnt + 1
End Sub

Private Sub Class_Initialize()
    mColumnCnt = 0
End Sub