Option Explicit 'このVBAモジュールはよくあるレイアウトのテーブル定義書からA5:SQL Mk-2用ER図ファイルのスケルトンを作成します。 '各定数と、SheetCheck関数を書き換えてCreateA5ER_Skeleton()を実行してください。 'このVBAモジュールで生成されるER図ファイルは最低限のものです。各列の主キーやデータ型も生成しません。 'ER図ファイルのスケルトンを生成した後、[ER図(D)] - [データベースとの同期処理(R)...]を実行することで、各列の主キーやデータ型などが正しく反映されます。 'テーブル論理名セルの行と列 Const TB_LNAME_COL = 3 Const TB_LNAME_ROW = 5 '※ 上の例では C5 セルにテーブル論理名が格納されているということになります。 'テーブル物理名セルの行と列 Const TB_PNAME_COL = 3 Const TB_PNAME_ROW = 6 '※ 上の例では C6 セルにテーブル物理名が格納されているということになります。 '列定義の開始行と論理名のカラム番号・物理名のカラム番号 Const COL_LNAME_COL = 2 Const COL_PNAME_COL = 3 Const COL_START_ROW = 14 ' ※ 各シートでCOL_START_ROWで示される行から下方向に行の情報を探します。 ' 物理名が空白の行を見つけたら、列定義が終了したと判断します。 ' シートがテーブル定義のシートかどうかチェックする(テーブル定義書の特徴にしたがって書き直してください) Public Function SheetCheck(Sheet As Worksheet) ' このサンプルではシートのA1セルの内容が "エンティティ名" の時、テーブル定義のシートであると判断しています。 If (Sheet.Cells(1, 1) = "テーブル情報") Or (Sheet.Cells(1, 1) = "エンティティ情報") Then ' テーブル定義のシート SheetCheck = True Else ' その他のシート(表紙とか変更履歴とかテーブル一覧とか…) SheetCheck = False End If End Function ' ■■■ 実行開始ポイント ■■■ ' ブックの各シートからER図を生成する Public Sub CreateA5ER_Skeleton() Dim nSheetIdx As Long ' シートの添え字 Dim Sheet As Worksheet ' シート Dim nFile As Long ' 出力ファイル Dim FileName As Variant ' 保存ファイル名または False ' 出力ファイルオープン FileName = Application.GetSaveAsFilename(FileFilter:="ER図ファイル, *.a5er") If (FileName = False) Then Exit Sub End If nFile = FreeFile Open FileName For Output Access Write As #nFile ' ER図ファイルのヘッダや共通情報を出力 Print #nFile, "# A5:ER FORMAT:06" ' FORMAT:06はA5:SQL Mk-2 Version 2.7系で保存された(あるいは互換性がある)ことを示す。Version 2.8系の時はFORMAT:07にする Print #nFile, "# A5:ER ENCODING:MS932" ' このファイルのエンコーディングがMS932であることを示す Print #nFile, "" Print #nFile, "[Manager]" Print #nFile, "Page=Main" ' 旧バージョン用ページ名情報 Print #nFile, "PageInfo=""Main"",4" ' Mainページ、表示レベルは「属性とデータ型(位置そろえ)」 Print #nFile, "LogicalView = 1" ' 論理名で表示 Print #nFile, "ViewModePageIndividually=1" ' ページごと表示レベルを指定する Print #nFile, "ViewMode=2" ' ページごと表示レベルを指定しない場合の表示レベル Print #nFile, "FontName=Tahoma" ' フォント名 Print #nFile, "FontSize=6" ' フォントサイズ Print #nFile, "PaperSize=A3Landscape" ' ページサイズ(A3横) Print #nFile, "" ' 各シートごとにエンティティを出力 For nSheetIdx = 1 To Worksheets.Count Set Sheet = Worksheets(nSheetIdx) If (SheetCheck(Sheet)) Then Call OutputEntity(nFile, Sheet) End If Next ' 出力ファイルクローズ Close nFile End Sub ' エンティティの情報を出力する Public Sub OutputEntity(nFile As Long, Sheet As Worksheet) Dim sLName As String 'テーブルまたはカラムの論理名 Dim sPName As String 'テーブルまたはカラムの物理名 Dim nIdx As Long Print #nFile, "[Entity]" ' テーブル情報出力 sLName = Trim(Sheet.Cells(TB_LNAME_ROW, TB_LNAME_COL)) sPName = Trim(Sheet.Cells(TB_PNAME_ROW, TB_PNAME_COL)) If (sLName = "") Then sLName = sPName End If Print #nFile, "LName=" & sLName Print #nFile, "PName=" & sPName ' 列情報出力 nIdx = COL_START_ROW Do While (Trim(Sheet.Cells(nIdx, COL_PNAME_COL)) <> "") sLName = Trim(Sheet.Cells(nIdx, COL_LNAME_COL)) sPName = Trim(Sheet.Cells(nIdx, COL_PNAME_COL)) If (sLName = "") Then sLName = sPName End If ' Field="論理名","物理名","データ型","NOT NULL",主キーの時 0〜,デフォルト式,コメント,色 (Version 2.7系) ' Field="論理名","物理名","データ型","NOT NULL",主キーの時 0〜,デフォルト式,コメント,色,DDLオプション (Version 2.8系) Print #nFile, "Field=""" & sLName & """,""" & sPName & ""","""",,,"""","""",$FFFFFFFF" nIdx = nIdx + 1 Loop ' 表示位置情報出力(エンティティの位置は単に乱数で決めています) Dim nX As Long, nY As Long nX = Rnd() * ((420 - 30) * 10) nY = Rnd() * ((297 - 30) * 10) Print #nFile, "Position=""MAIN""," & CStr(nX) & "," & CStr(nY) Print #nFile, "" End Sub