Visio ER図の情報を取得する - 版の履歴

2020年2月16日 (日) 04:33にPirotoによる

2020-02-16T04:33:54Z

2020年2月15日 (土) 08:39にPirotoによる

2020-02-15T08:39:55Z

2020年2月15日 (土) 08:23にPirotoによる

2020-02-15T08:23:48Z

2020年2月15日 (土) 08:06にPirotoによる

2020-02-15T08:06:44Z

Piroto: ページの作成:「==Visio ER図の情報を取得する== [Visio][VBA] *http://msdn.microsoft.com/ja-jp/library/cc377254.aspx ===モジュール=== VisioのER図をCSV出力する…」

2020-02-15T07:36:38Z

ページの作成:「==Visio ER図の情報を取得する== [Visio][VBA] *http://msdn.microsoft.com/ja-jp/library/cc377254.aspx ===モジュール=== VisioのER図をCSV出力する…」

新規ページ

==Visio ER図の情報を取得する==
[Visio][VBA]

*http://msdn.microsoft.com/ja-jp/library/cc377254.aspx

===モジュール===
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

@@ 1行目: / 1行目: @@
 ==Visio ER図の情報を取得する==
-[[Visio]][[VBA]]
+[[Visio]] | [[VBA]] |
 *http://msdn.microsoft.com/ja-jp/library/cc377254.aspx

@@ 1行目: / 1行目: @@
 ==Visio ER図の情報を取得する==
-[[Visio][VBA]]
+[[Visio]][[VBA]]
 *http://msdn.microsoft.com/ja-jp/library/cc377254.aspx

@@ 1行目: / 1行目: @@
-==Visio ER図の情報を取得する==
+==[[Visio ER図の情報を取得する]]==
 [[Visio]] | [[VBA]] |
@@ 5行目: / 5行目: @@
 ===モジュール===
-VisioのER図をCSV出力するマクロ
+[[Visio]]のER図をCSV出力するマクロ
-{{ref MakeVisioEntityList.zip}}
+{{ref Make[[Visio]]EntityList.zip}}
 &lt;blockquote&gt;メタ情報が取得しかたがわからない(そもそもできる？)。。。&lt;/blockquote&gt;
@@ 12行目: / 12行目: @@
   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")
-      'Visioドキュメントのページ単位で処理
+      '[[Visio]]ドキュメントのページ単位で処理
       Set docPages = Application.ActiveDocument.Pages
       docPageCnt = docPages.Count
@@ 38行目: / 38行目: @@
       For i = 1 To docPageCnt
           'Entity辞書のクリア
-          Call entityDict.RemoveAll
+          Call entityDict.[[R]]emoveAll
           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
@@ 71行目: / 71行目: @@
           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)
@@ 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 partsShape      As Shape
@@ 92行目: / 92行目: @@
       Dim ent             As Entity
       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
@@ 118行目: / 118行目: @@
           Case 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
-                  col.Name = splitedRow(0)
+                  col.Name = splited[[R]]ow(0)
-                  col.DataType = splitedRow(1)
+                  col.DataType = splited[[R]]ow(1)
                   If Trim(col.Name) &lt;&gt; "" Then
@@ 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 i               As Integer
@@ 150行目: / 150行目: @@
       If Trim(row) &lt;&gt; "" Then
-          tmp = Split(row, COL_SEP_CHAR)
+          tmp = Split(row, COL_SEP_CHA[[R]])
           If UBound(tmp) &gt; 0 Then
@@ 159行目: / 159行目: @@
           End If
       End If
-      SplitRow = ret
+      Split[[R]]ow = ret
   End Function
@@ 170行目: / 170行目: @@
       Dim i           As Integer
-      keywords = Split(EXCEPT_SHEET_KEYWORD, ",")
+      keywords = Split(EXCEPT_SHEET_KEYWO[[R]]D, ",")
       For i = LBound(keywords) To UBound(keywords)
@@ 236行目: / 236行目: @@
       Columns = mColumns
   End Property
-  Public Property Let Columns(ByRef newColumns() As Column)
+  Public Property Let Columns(By[[R]]ef newColumns() As Column)
       Set mColumns = newColumns
   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

@@ 1行目: / 1行目: @@
 ==Visio ER図の情報を取得する==
-[Visio][VBA]
+[[Visio][VBA]]
 *http://msdn.microsoft.com/ja-jp/library/cc377254.aspx
@@ 7行目: / 7行目: @@
 VisioのER図をCSV出力するマクロ
 {{ref MakeVisioEntityList.zip}}
-<blockquote>メタ情報が取得しかたがわからない(そもそもできる？)。。。</blockquote>
+&lt;blockquote&gt;メタ情報が取得しかたがわからない(そもそもできる？)。。。&lt;/blockquote&gt;
   'ログ出力の抑制
@@ 126行目: / 126行目: @@
                   col.DataType = splitedRow(1)
-                  If Trim(col.Name) <> "" Then
+                  If Trim(col.Name) &lt;&gt; "" Then
                       Call ent.AddColumn(col)
                   End If
@@ 149行目: / 149行目: @@
       ret(1) = ""
-      If Trim(row) <> "" Then
+      If Trim(row) &lt;&gt; "" Then
           tmp = Split(row, COL_SEP_CHAR)
-          If UBound(tmp) > 0 Then
+          If UBound(tmp) &gt; 0 Then
               ret(0) = Trim(tmp(0))
               ret(1) = Trim(tmp(1))
@@ 173行目: / 173行目: @@
       For i = LBound(keywords) To UBound(keywords)
-          ret = InStr(sheetName, keywords(i)) > 0
+          ret = InStr(sheetName, keywords(i)) &gt; 0
           If ret Then
               Exit For