「Visio ER図の情報を取得する」の版間の差分
ナビゲーションに移動
検索に移動
(ページの作成:「==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出力するマクロ | |
− | {{ref | + | {{ref Make[[Visio]]EntityList.zip}} |
− | + | <blockquote>メタ情報が取得しかたがわからない(そもそもできる?)。。。</blockquote> | |
'ログ出力の抑制 | 'ログ出力の抑制 | ||
Private Const IS_LOGGING As Boolean = True | Private Const IS_LOGGING As Boolean = True | ||
− | ' | + | '除外する[[Visio]]シート名(一部一致をカンマ区切り) |
− | Private Const | + | Private Const EXCEPT_SHEET_KEYWO[[R]]D As String = "背景" |
'エンティティを識別するためのマスターシェイプ名 | 'エンティティを識別するためのマスターシェイプ名 | ||
− | Private Const | + | Private Const MASTE[[R]]_SHAPE_ENTITY_NAME_U As String = "Entity" |
' | ' | ||
32行目: | 32行目: | ||
Set entityDict = CreateObject("Scripting.Dictionary") | Set entityDict = CreateObject("Scripting.Dictionary") | ||
− | ' | + | '[[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. | + | Call entityDict.[[R]]emoveAll |
Set docPage = docPages.Item(i) | Set docPage = docPages.Item(i) | ||
57行目: | 57行目: | ||
' シートごとの処理 | ' シートごとの処理 | ||
' | ' | ||
− | Private Sub ParsePage( | + | 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, | + | 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( | + | 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 | + | Dim rare[[R]]ow() As String |
− | Dim | + | Dim splited[[R]]ow() As String |
Set partsShapes = entityShape.Shapes | Set partsShapes = entityShape.Shapes | ||
118行目: | 118行目: | ||
Case 2 | Case 2 | ||
'2:列情報 | '2:列情報 | ||
− | + | rare[[R]]ow = Split(partsShape.Text, vbLf) | |
− | For j = LBound( | + | For j = LBound(rare[[R]]ow) To UBound(rare[[R]]ow) |
− | + | splited[[R]]ow = Split[[R]]ow(rare[[R]]ow(j)) | |
Set col = New Column | Set col = New Column | ||
− | col.Name = | + | col.Name = splited[[R]]ow(0) |
− | col.DataType = | + | col.DataType = splited[[R]]ow(1) |
− | If Trim(col.Name) | + | If Trim(col.Name) <> "" Then |
Call ent.AddColumn(col) | Call ent.AddColumn(col) | ||
End If | End If | ||
138行目: | 138行目: | ||
' 列名とデータ型を分ける | ' 列名とデータ型を分ける | ||
' | ' | ||
− | Private Function | + | Private Function Split[[R]]ow(By[[R]]ef row As String) As String() |
− | Const | + | 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) | + | If Trim(row) <> "" Then |
− | tmp = Split(row, | + | tmp = Split(row, COL_SEP_CHA[[R]]) |
− | If UBound(tmp) | + | If UBound(tmp) > 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 | ||
− | + | Split[[R]]ow = ret | |
End Function | End Function | ||
170行目: | 170行目: | ||
Dim i As Integer | Dim i As Integer | ||
− | keywords = Split( | + | 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)) | + | ret = InStr(sheetName, keywords(i)) > 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( | + | Public Property Let Columns(By[[R]]ef newColumns() As Column) |
Set mColumns = newColumns | Set mColumns = newColumns | ||
End Property | End Property | ||
− | Public Sub AddColumn( | + | Public Sub AddColumn(By[[R]]ef col As Column) |
− | + | [[R]]eDim Preserve mColumns(mColumnCnt) | |
Set mColumns(mColumnCnt) = col | Set mColumns(mColumnCnt) = col |
2020年2月16日 (日) 04:33時点における最新版
Visio ER図の情報を取得する
モジュール
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
© 2006 矢木浩人