SQL Server データ駆動型 Visio 図面自動生成：伝説のアーキテクトが語る極限の自動化戦略
長年、業務自動化の最前線で数多のシステムを設計・実装してきた者として、Visio VBAの深淵を覗き、その真髄を語る機会を得たことを光栄に思う。特に、SQL Server から取得したデータに基づき、テンプレートから動的に図面を生成・保存する――このテーマは、単なる自動化の範疇を超え、データとビジュアライゼーションが融合する、まさに「動くシステム」を創造する極意に他ならない。
本稿では、シニアエンジニアや社内システム管理者を読者層とし、Windows APIの呼び出し、メモリ最適化、レガシー環境の保守、そしてシステム間連携といった、現場で直面するであろう「極限」とも言える課題に、伝説のチーフアーキテクトとして、その経験と知見を惜しみなく開示していく。退屈なリファレンスの羅列ではなく、オブジェクトのライフサイクル、パフォーマンスの重み――それらを熟知した者だけが到達できる境地を、魂を込めて解説しよう。
1. データ駆動型図面生成のアーキテクチャ：ADO、Visio API、そして「魂」
我々が目指すのは、単にデータをVisioに流し込むという表面的な自動化ではない。SQL Server の持つ構造化された情報を、Visio の持つ表現力豊かな図形と結びつけ、ビジネスロジックを視覚化する、生きたドキュメントを生成することだ。この壮大なプロジェクトの心臓部となるのは、以下の要素である。
- ADO (ActiveX Data Objects): データベースとの対話は、ADO を介して行われる。これにより、SQL Server から必要なデータを柔軟かつ効率的に取得する。
- Visio API: Visio のオブジェクトモデルを駆使し、図形の配置、テキストの編集、コネクタの描画など、図面を動的に構築する。
- テンプレートファイル (.vstx): 図面の骨格となるテンプレートを用意する。これにより、一貫性のあるデザインとレイアウトを保ちつつ、データに基づいたカスタマイズを可能にする。
この三位一体こそが、データ駆動型図面生成の基盤となる。しかし、真の極意は、これらの要素を単に組み合わせるだけではない。各コンポーネントのライフサイクルを理解し、リソースを最適に管理すること。そして、時にはレガシーシステムとの共存、あるいは Windows API の直接的な呼び出しといった、より低レベルな制御も辞さない覚悟が求められる。
2. ADOによるデータ取得：効率と堅牢性の両立
まず、SQL Server からデータを取得する部分から始めよう。ここでは、`ADOX` (ADO Extensions for DDL and Security) を使用して、データベーススキーマの情報を取得することも視野に入れるが、今回はより一般的な `Recordset` オブジェクトに焦点を当てる。
‘ VBA Code Example: Fetching data from SQL Server using ADO
Sub FetchDataFromSQLServer()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConnectionString As String
Dim strSQL As String
‘ — Connection String —
‘ Replace with your actual server, database, and authentication details
‘ For Windows Authentication:
‘ strConnectionString = “Provider=SQLNCLI11;Server=your_server_name;Database=your_database_name;Trusted_Connection=yes;”
‘ For SQL Server Authentication:
strConnectionString = “Provider=SQLNCLI11;Server=your_server_name;Database=your_database_name;Uid=your_username;Pwd=your_password;”
‘ — SQL Query —
‘ Example: Select data for network devices
strSQL = “SELECT DeviceName, IPAddress, DeviceType FROM NetworkDevices WHERE IsActive = 1;”
‘ — Initialize objects —
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
On Error GoTo ErrorHandler
‘ — Open the connection —
cn.Open strConnectionString
Debug.Print “Database connection opened successfully.”
‘ — Open the recordset —
‘ adOpenStatic: Allows moving backward, adLockOptimistic: Allows record updates
rs.Open strSQL, cn, adOpenStatic, adLockOptimistic
‘ — Process the data —
If Not rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF
Dim deviceName As String
Dim ipAddress As String
Dim deviceType As String
deviceName = Nz(rs.Fields(“DeviceName”).Value, “N/A”) ‘ Handle potential NULL values
ipAddress = Nz(rs.Fields(“IPAddress”).Value, “N/A”)
deviceType = Nz(rs.Fields(“DeviceType”).Value, “Unknown”)
Debug.Print “Device: ” & deviceName & “, IP: ” & ipAddress & “, Type: ” & deviceType
‘ — TODO: Use this data to create Visio shapes —
‘ Example: Call a subroutine to create a shape based on deviceType
rs.MoveNext
Loop
Else
Debug.Print “No data found matching the query.”
End If
‘ — Cleanup —
rs.Close
cn.Close
Debug.Print “Database connection closed.”
Exit Sub
ErrorHandler:
MsgBox “An error occurred: ” & Err.Description, vbCritical
‘ — Ensure cleanup even if an error occurs —
If Not rs Is Nothing Then
If rs.State <> adStateClosed Then rs.Close
End If
If Not cn Is Nothing Then
If cn.State <> adStateClosed Then cn.Close
End If
End Sub
‘ Helper function to handle NULL values from database
Function Nz(Value As Variant, Optional NzValue As Variant = “”) As Variant
If IsNull(Value) Then
Nz = NzValue
Else
Nz = Value
End If
End Function
極限の知見:
- 接続文字列の堅牢性: 接続文字列は、環境変数や設定ファイルから読み込むのが鉄則だ。ハードコーディングは、セキュリティリスクと保守性の低下を招く。特にレガシー環境では、`SQLNCLI11` のようなプロバイダーのバージョン互換性にも注意が必要だ。
- レコードセットのモード: `adOpenStatic` は、後方移動を可能にし、デバッグやデータ検証に役立つ。しかし、大量のデータを扱う場合は、メモリ消費に注意し、必要に応じて `adOpenForwardOnly` を検討する。`adLockOptimistic` は、データ取得後の更新を想定しないのであれば、より軽量な `adLockReadOnly` を選択すべきだ。
- NULL 値のハンドリング: データベースからの NULL 値は、VBA では `Empty` や `Null` として扱われる。`Nz` 関数のようなヘルパー関数を用意し、予期せぬエラーを防ぐことが重要だ。
- エラーハンドリング: `On Error GoTo` は基本だが、リソースの解放を確実に行うことが肝心だ。`ErrorHandler` ラベルで、接続やレコードセットが閉じられているかを確認し、明示的に解放する。
3. Visio APIによる図面生成：オブジェクトのライフサイクルを制する者
次に、取得したデータを元に Visio 図面を生成する部分だ。ここで、Visio API を駆使する際の「オブジェクトのライフサイクル」と「メモリ最適化」が極めて重要になる。
‘ VBA Code Example: Generating Visio shapes from fetched data
Sub GenerateVisioDiagram(rs As ADODB.Recordset, templatePath As String)
Dim visApp As Visio.Application
Dim visDoc As Visio.Document
Dim visPage As Visio.Page
Dim visShape As Visio.Shape
Dim visStencil As Visio.Document ‘ For stencils if needed
Dim pageWidth As Double
Dim pageHeight As Double
‘ — Configuration —
Const SHAPE_TYPE_NETWORK_DEVICE As String = “Network Equipment” ‘ Example Master Shape name in stencil
Const SHAPE_TYPE_SERVER As String = “Server”
Const STENCIL_NAME As String = “Basic Network Shapes.vssx” ‘ Example stencil file
‘ — Initialize Visio Application —
On Error Resume Next
Set visApp = GetObject(, “Visio.Application”) ‘ Try to get existing instance
On Error GoTo ErrorHandler
If visApp Is Nothing Then
Set visApp = CreateObject(“Visio.Application”) ‘ Create new instance if none exists
visApp.Visible = True ‘ Make Visio visible (for debugging, can be set to False for production)
End If
‘ — Open the template —
Set visDoc = visApp.Documents.Open(templatePath)
Set visPage = visDoc.Pages(1) ‘ Assuming we are using the first page
‘ — Page dimensions —
pageWidth = visPage.PageSheet.Cells(“PageWidth”).ResultIU
pageHeight = visPage.PageSheet.Cells(“PageHeight”).ResultIU
‘ — Load stencil (if shapes are not already on the template) —
‘ You might have shapes directly on the template, or you might need to load a stencil
‘ For simplicity, let’s assume shapes are available as masters in the stencil
On Error Resume Next
Set visStencil = visApp.Documents(STENCIL_NAME)
On Error GoTo ErrorHandler
If visStencil Is Nothing Then
‘ If stencil not open, open it.
Set visStencil = visApp.Documents.Add(visApp.GetBuiltInStencilPath(STENCIL_NAME))
End If
‘ — Process data and create shapes —
If Not rs.EOF Then
rs.MoveFirst
Dim yPos As Double
yPos = pageHeight 0.8 ‘ Start placing shapes from the top
Do While Not rs.EOF
Dim deviceName As String
Dim ipAddress As String
Dim deviceType As String
deviceName = Nz(rs.Fields(“DeviceName”).Value, “N/A”)
ipAddress = Nz(rs.Fields(“IPAddress”).Value, “N/A”)
deviceType = Nz(rs.Fields(“DeviceType”).Value, “Unknown”)
Dim masterShapeName As String
Select Case deviceType
Case “Router”, “Switch”
masterShapeName = SHAPE_TYPE_NETWORK_DEVICE
Case “Server”
masterShapeName = SHAPE_TYPE_SERVER
Case Else
masterShapeName = “Document” ‘ Fallback shape
End Select
‘ — Get the master shape from the stencil —
Dim master As Visio.Master
On Error Resume Next
Set master = visStencil.Masters(masterShapeName)
On Error GoTo ErrorHandler
If Not master Is Nothing Then
‘ — Add the shape to the page —
‘ Position: x=pageWidth/2, y=yPos
‘ Cells(“PinX”) and Cells(“PinY”) control the shape’s origin relative to the page
Set visShape = visPage.Drop(master, pageWidth / 2, yPos)
‘ — Set shape text (e.g., device name and IP) —
visShape.Text = deviceName & vbCrLf & ipAddress
‘ — Update shape properties if needed (e.g., color, size) —
‘ visShape.Cells(“FillForegnd”).Formula = “RGB(255,0,0)” ‘ Red color
‘ — Adjust position for the next shape —
yPos = yPos – (visShape.Cells(“Height”).ResultIU 1.5) ‘ Move down, with some spacing
‘ — Clean up shape object —
Set visShape = Nothing
Set master = Nothing
Else
Debug.Print “Master shape ‘” & masterShapeName & “‘ not found in stencil.”
End If
rs.MoveNext
Loop
Else
Debug.Print “No data to generate shapes.”
End If
‘ — Save the document —
‘ Save as VSDX (XML-based format)
Dim savePath As String
savePath = Replace(templatePath, “.vstx”, “_” & Format(Now, “yyyymmdd_hhmmss”) & “.vsdx”)
visDoc.SaveAs filename:=savePath
Debug.Print “Diagram saved to: ” & savePath
‘ — PDF Output —
‘ This part requires careful handling of export settings.
‘ The PrintOut method or Export method can be used.
‘ For Export method:
‘ visDoc.Export “C:\path\to\output.pdf” ‘ Simple export
‘ For more control, use PrintOut with specific printer settings (can be complex)
‘ Example of saving as PDF using Export method (simplified)
Dim pdfPath As String
pdfPath = Replace(savePath, “.vsdx”, “.pdf”)
‘ Ensure the printer is set correctly or use a PDF virtual printer
‘ This might require Windows API calls to set the default printer if not handled by Visio settings
‘ For robust PDF export, consider using the Export method with specific settings if available
‘ visDoc.Export pdfPath ‘ This might not work directly for PDF without specific settings.
‘ A more reliable way might be to print to a PDF printer.
‘ — Cleanup Visio Objects —
‘ IMPORTANT: Close the document without saving if it’s just a template being modified
‘ If you opened a template and saved it as a new file, you can close the original template if needed.
‘ visDoc.Close ‘ Close the current document
visDoc.Close visSaveChangesNo ‘ Close without saving changes to the template itself
‘ If you created a new Visio instance, you might want to quit it.
‘ However, if GetObject found an existing instance, we shouldn’t quit it.
‘ A more robust approach is to track if we created the instance.
‘ Example of quitting if we created the instance (requires tracking)
‘ If bVisioWasCreated Then visApp.Quit
Set visPage = Nothing
Set visDoc = Nothing
Set visApp = Nothing
Set visStencil = Nothing
Exit Sub
ErrorHandler:
MsgBox “An error occurred during Visio diagram generation: ” & Err.Description, vbCritical
‘ — Ensure cleanup —
If Not visShape Is Nothing Then Set visShape = Nothing
If Not master Is Nothing Then Set master = Nothing
If Not visStencil Is Nothing Then
If visStencil.Saved Then visStencil.Close visSaveChangesNo
Set visStencil = Nothing
End If
If Not visPage Is Nothing Then Set visPage = Nothing
If Not visDoc Is Nothing Then
If visDoc.Saved Then visDoc.Close visSaveChangesNo ‘ Close without saving
End If
If Not visApp Is Nothing Then
‘ Careful here: only quit if we created the instance.
‘ A common pattern is to use a flag.
‘ If g_bVisioCreated Then visApp.Quit
End If
Set visApp = Nothing
End Sub
‘ — Main Subroutine to orchestrate the process —
Sub CreateDiagramFromDatabase()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConnectionString As String
Dim strSQL As String
Dim templatePath As String
‘ — Configuration —
‘ Replace with your actual server, database, and authentication details
strConnectionString = “Provider=SQLNCLI11;Server=your_server_name;Database=your_database_name;Uid=your_username;Pwd=your_password;”
strSQL = “SELECT DeviceName, IPAddress, DeviceType FROM NetworkDevices WHERE IsActive = 1;”
templatePath = “C:\Path\To\Your\NetworkDiagramTemplate.vstx” ‘ Path to your Visio template
‘ — Initialize ADO objects —
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
On Error GoTo ErrorHandlerADO
‘ — Open connection and recordset —
cn.Open strConnectionString
rs.Open strSQL, cn, adOpenStatic, adLockOptimistic
‘ — Call the Visio generation routine —
GenerateVisioDiagram rs, templatePath
‘ — Cleanup ADO objects —
rs.Close
cn.Close
Debug.Print “ADO objects cleaned up.”
GoTo ExitRoutine
ErrorHandlerADO:
MsgBox “An error occurred during data retrieval: ” & Err.Description, vbCritical
‘ Ensure ADO cleanup even if Visio generation fails later
If Not rs Is Nothing Then
If rs.State <> adStateClosed Then rs.Close
End If
If Not cn Is Nothing Then
If cn.State <> adStateClosed Then cn.Close
End If
‘ Exit Sub will be handled by GoTo ExitRoutine if Visio part succeeded
ExitRoutine:
‘ Cleanup ADO objects if they were successfully initialized and processed
If Not rs Is Nothing Then
If rs.State <> adStateClosed Then rs.Close
End If
If Not cn Is Nothing Then
If cn.State <> adStateClosed Then cn.Close
End If
Set rs = Nothing
Set cn = Nothing
End Sub
極限の知見:
- `GetObject` vs `CreateObject`: 既存の Visio インスタンスを利用できる場合は、`GetObject` を使用することで、起動・終了のオーバーヘッドを削減できる。ただし、どのインスタンスを取得するかの制御は難しいため、通常は `CreateObject` で新規に起動し、処理完了後に `Quit` するのが一般的だ。本コードでは、両方のケースを考慮しているが、どちらか一方に絞るべきだ。
- オブジェクトの明示的解放: VBA では、オブジェクト変数を `Set obj = Nothing` で明示的に解放することが、メモリリークを防ぐための基本中の基本だ。特に、ループ内で大量のオブジェクトが生成される場合、この処理を怠ると、あっという間にメモリを圧迫し、パフォーマンス低下やクラッシュを招く。`visShape` や `master` オブジェクトは、ループの各イテレーションで解放すること。
- `visApp.Documents.Open` の挙動: テンプレートファイル (.vstx) を `Open` すると、通常は新しいドキュメントとして開かれる。これを `SaveAs` することで、元のテンプレートは変更されない。もしテンプレート自体を変更したい場合は、`Open` の後に `Save` を実行する必要がある。
- ステンシルの扱い: マスターシェイプをステンシルから取得する際、ステンシルが開かれていない場合は、`Documents.Add` で開く必要がある。`GetBuiltInStencilPath` を使うと、Visio のインストールパスにある標準ステンシルを安全に参照できる。
- PDF 出力: PDF 出力は、Visio の `Export` メソッドや `PrintOut` メソッドを使用する。`Export` は、特定のファイル形式への変換に便利だが、PDF の場合、詳細な設定（解像度、ページ範囲など）は、`Export` メソッドの引数や、COM オブジェクトのプロパティを直接操作する必要がある場合がある。より高度な制御が必要な場合は、Windows API を用いて PDF プリンターを操作することも検討する。
- `visSaveChangesNo`: テンプレートファイル自体への変更を保存したくない場合は、`visDoc.Close visSaveChangesNo` を使用する。これは、無用なテンプレートの変更を防ぐために重要だ。
- `Shape.Cells` へのアクセス: 図形のプロパティ（幅、高さ、色など）は、`Shape.Cells(“CellName”)` でアクセスできる。`.ResultIU` は、インチ単位での結果を取得する。他の単位系（ミリメートルなど）に変換するには、対応するプロパティを使用するか、計算を行う必要がある。
4. Windows API 呼び出し：Visio の外側を制御する
VBA の標準機能だけでは実現できない、より低レベルな制御が必要な場面――例えば、PDF プリンターの選択、特定のフォルダーへの自動保存、あるいは他のアプリケーションとの連携――においては、Windows API の呼び出しが不可欠となる。
ここでは、PDF プリンターを動的に設定する例を示そう。これは、`PrintOut` メソッドで PDF に出力する際に、どの PDF プリンターを使用するかをプログラムで制御したい場合に役立つ。
‘ VBA Code Example: Using Windows API to set the default printer
‘ — Declare API functions —
‘ For Windows API calls, you need to declare them at the top of your module.
‘ If you are using VB.NET, you would use ‘Declare Auto Function’ or similar in a module.
‘ Declare API functions for printer management
If VBA7 Then ‘ 64-bit VBA
Private Declare PtrSafe Function EnumPrinters Lib “winspool.drv” Alias “EnumPrintersA” ( _
ByVal Flags As Long, _
ByVal Name As String, _
ByVal Level As Long, _
ByVal pPrinterEnum As Long, _
ByVal cbBuf As Long, _
ByRef pcbNeeded As Long, _
ByVal lPref As Long) As Long
Private Declare PtrSafe Function OpenPrinter Lib “winspool.drv” Alias “OpenPrinterA” ( _
ByVal pPrinterName As String, _
ByRef phPrinter As LongPtr, _
ByVal pDefault As Any) As Long
Private Declare PtrSafe Function SetPrinter Lib “winspool.drv” Alias “SetPrinterA” ( _
ByVal hPrinter As LongPtr, _
ByVal Level As Long, _
ByVal pPrinter As Any, _
ByVal Command As Long) As Long
Private Declare PtrSafe Function ClosePrinter Lib “winspool.drv” ( _
ByVal hPrinter As LongPtr) As Long
Else ‘ 32-bit VBA
Private Declare Function EnumPrinters Lib “winspool.drv” Alias “EnumPrintersA” ( _
ByVal Flags As Long, _
ByVal Name As String, _
ByVal Level As Long, _
ByVal pPrinterEnum As Long, _
ByVal cbBuf As Long, _
ByRef pcbNeeded As Long, _
ByVal lPref As Long) As Long
Private Declare Function OpenPrinter Lib “winspool.drv” Alias “OpenPrinterA” ( _
ByVal pPrinterName As String, _
ByRef phPrinter As Long, _
ByVal pDefault As Any) As Long
Private Declare Function SetPrinter Lib “winspool.drv” Alias “SetPrinterA” ( _
ByVal hPrinter As Long, _
ByVal Level As Long, _
ByVal pPrinter As Any, _
ByVal Command As Long) As Long
Private Declare Function ClosePrinter Lib “winspool.drv” ( _
ByVal hPrinter As Long) As Long
End If
‘ — Constants for EnumPrinters —
Const PRINTER_ENUM_LOCAL As Long = &H2
Const PRINTER_CONTAINER As Long = &H1
Const PRINTER_ENUM_CONNECTIONS As Long = &H4
Const PRINTER_ENUM_FAVORITE As Long = &H4
Const PRINTER_ENUM_NAME As Long = &H1
Const PRINTER_ENUM_REMOTE As Long = &H1
Private Const LEVEL_2 As Long = 2
‘ — Structure for PRINTER_INFO_2 —
‘ This structure is used by EnumPrinters to get detailed information about printers.
‘ In VBA, we often use Type…End Type to define structures.
‘ For simplicity and to avoid complex memory management here, we’ll focus on getting the name.
‘ A full implementation would require careful memory allocation and deallocation.
‘ — Function to get a list of available printers —
Function GetPrinterNames() As Collection
Dim printers As New Collection
Dim pcbNeeded As Long
Dim pPrinterEnum As Long
Dim cbBuf As Long
Dim ret As Long
Dim i As Long
Dim printerName As String
‘ Call EnumPrinters to determine the buffer size needed
ret = EnumPrinters(PRINTER_ENUM_LOCAL Or PRINTER_ENUM_CONNECTIONS, vbNullString, LEVEL_2, 0, 0, pcbNeeded, 0)
If ret = 0 And pcbNeeded > 0 Then
‘ Allocate memory for the printer information buffer
pPrinterEnum = GlobalAlloc(GPTR, pcbNeeded) ‘ GPTR = GlobalAlloc(GMEM_FIXED, …)
If pPrinterEnum <> 0 Then
ret = EnumPrinters(PRINTER_ENUM_LOCAL Or PRINTER_ENUM_CONNECTIONS, vbNullString, LEVEL_2, pPrinterEnum, pcbNeeded, pcbNeeded, 0)
If ret <> 0 Then
Dim pPrinterInfo As LongPtr ‘ Pointer to PRINTER_INFO_2 structure
Dim pNamePtr As LongPtr ‘ Pointer to printer name string
Dim lpDriverNamePtr As LongPtr ‘ Pointer to driver name string
‘ Loop through the returned printer information
pPrinterInfo = pPrinterEnum ‘ Start of the buffer
For i = 0 To pcbNeeded \ SizeOfPrinterInfo2() – 1 ‘ Approximate loop count
‘ Extract printer name (field pName: offset 4 in PRINTER_INFO_2)
pNamePtr = pPrinterInfo + 4
printerName = StrPtrToNullTermString(pNamePtr)
If Len(printerName) > 0 Then
printers.Add printerName
End If
‘ Move to the next PRINTER_INFO_2 structure in the buffer
pPrinterInfo = pPrinterInfo + SizeOfPrinterInfo2()
Next i
End If
‘ Free the allocated memory
GlobalFree pPrinterEnum
End If
End If
Set GetPrinterNames = printers
End Function
‘ — Function to set the default printer —
Function SetDefaultPrinter(printerName As String) As Boolean
Dim hPrinter As LongPtr
Dim ret As Long
Dim defaultPrinterName As String
Dim defaultPrinterInfo As PRINTER_INFO_2 ‘ Using a VBA Type for PRINTER_INFO_2
SetDefaultPrinter = False
‘ Get the current default printer’s info to pass to SetPrinter
ret = OpenPrinter(printerName, hPrinter, ByVal vbNullString)
If ret <> 0 Then
‘ Get the size of PRINTER_INFO_2 for the current default printer
Dim cbNeeded As Long
ret = GetPrinter(hPrinter, LEVEL_2, 0, 0, cbNeeded) ‘ Call with 0 to get size
If ret = 0 Then
Dim pBuffer As LongPtr
pBuffer = GlobalAlloc(GPTR, cbNeeded)
If pBuffer <> 0 Then
ret = GetPrinter(hPrinter, LEVEL_2, pBuffer, cbNeeded, cbNeeded)
If ret <> 0 Then
‘ Copy the data from the API buffer to our VBA structure
CopyMemory ByRef defaultPrinterInfo, ByVal pBuffer, SizeOfPrinterInfo2()
‘ We are not actually changing the default printer here, just getting its info.
‘ To set the default printer, we need to pass PRINTER_INFO_2 structure to SetPrinter
‘ This requires more complex memory management and structure handling.
‘ For simplicity, we’ll assume the existence of a function that sets it.
‘ The common way to set the default printer is through the Win32 API function
‘ SetDefaultPrinter. However, that function is not directly exposed in VBA.
‘ The SetPrinter API can be used to modify printer settings, including default status.
‘ A simpler approach might be to use the ‘rundll32 printui.dll,PrintUIEntry’ command.
‘ For direct API, we need to populate PRINTER_INFO_2 with the desired printer name.
‘ Let’s assume we want to set the printer named ‘printerName’ as default.
‘ We need to get the PRINTER_INFO_2 structure of the target printer.
Dim targetPrinterInfo As PRINTER_INFO_2
Dim hTargetPrinter As LongPtr
ret = OpenPrinter(printerName, hTargetPrinter, ByVal vbNullString)
If ret <> 0 Then
Dim cbTargetNeeded As Long
ret = GetPrinter(hTargetPrinter, LEVEL_2, 0, 0, cbTargetNeeded)
If ret = 0 Then
Dim pTargetBuffer As LongPtr
pTargetBuffer = GlobalAlloc(GPTR, cbTargetNeeded)
If pTargetBuffer <> 0 Then
ret = GetPrinter(hTargetPrinter, LEVEL_2, pTargetBuffer, cbTargetNeeded, cbTargetNeeded)
If ret <> 0 Then
‘ Copy to our VBA structure
CopyMemory ByRef targetPrinterInfo, ByVal pTargetBuffer, SizeOfPrinterInfo2()
‘ Mark this printer as default (this requires setting the PRINTER_INFO_2 structure correctly)
‘ The PRINTER_INFO_2 structure doesn’t have a direct “IsDefault” flag.
‘ Setting the default printer is more complex and often involves registry manipulation
‘ or using specific Win32 APIs like SetDefaultPrinter.
‘ Simplified approach using the command line for demonstration
‘ This is not a direct API call but a common workaround.
Dim cmd As String
cmd = “rundll32 printui.dll,PrintUIEntry /y /n “”” & printerName & “”””
Shell cmd, vbHide
SetDefaultPrinter = True ‘ Assume success for the command line version
End If
End If
GlobalFree pTargetBuffer
End If
ClosePrinter hTargetPrinter
End If
End If
End If
GlobalFree pBuffer
End If
ClosePrinter hPrinter
End If
‘ The direct API method for setting the default printer is quite involved.
‘ The command-line approach (Shell) is often easier in VBA for this specific task.
‘ If a direct API solution is absolutely required, one would need to:
‘ 1. Get the PRINTER_INFO_2 of the desired printer.
‘ 2. Potentially iterate through all printers and clear their ‘default’ status.
‘ 3. Set the desired printer’s status (this is the tricky part as PRINTER_INFO_2 doesn’t have a simple flag).
‘ The code above demonstrates the complexity and points towards the command-line approach.
‘ For actual implementation, consider the Shell method or a dedicated library.
End Function
‘ — Helper to get the size of PRINTER_INFO_2 structure —
‘ This is a simplified calculation and might need adjustment based on memory alignment.
‘ A more reliable way is to use GetObjectSize or similar if available, or manual calculation.
Private Function SizeOfPrinterInfo2() As Long
‘ Based on typical offsets and sizes in Windows API structures:
‘ pszDriverName (LPSTR) – 4 bytes
‘ pszDatatype (LPSTR) – 4 bytes
‘ pszPrintProcessor (LPSTR) – 4 bytes
‘ pszLocation (LPSTR) – 4 bytes
‘ pszComment (LPSTR) – 4 bytes
‘ pszStatus (LPSTR) – 4 bytes
‘ dwStatus (DWORD) – 4 bytes
‘ dwAttributes (DWORD) – 4 bytes
‘ dwPriority (DWORD) – 4 bytes
‘ dwDefaultPriority (DWORD) – 4 bytes
‘ dwStartTime (SYSTEMTIME) – 8 bytes (wYear, wMonth, wDay, wHour, wMinute, wSecond, wMilliseconds) 8
‘ dwUntilTime (SYSTEMTIME) – 8 bytes
‘ pszSepFile (LPSTR) – 4 bytes
‘ pszColorProfiles (LPSTR) – 4 bytes
‘ pszPaperSizes (LPSTR) – 4 bytes
‘ pszPaperSizeDefault (LPSTR) – 4 bytes
‘ pszFormNames (LPSTR) – 4 bytes
‘ pszFormSizesDefault (LPSTR) – 4 bytes
‘ dwEnvironment (LPSTR) – 4 bytes
‘ pszPortName (LPSTR) – 4 bytes
‘ pszMonitorName (LPSTR) – 4 bytes
‘ pszDefaultSource (LPSTR) – 4 bytes
‘ dwColor (DWORD) – 4 bytes
‘ dwDeviceID (DWORD) – 4 bytes
‘ pszDirect (LPSTR) – 4 bytes
‘ pszDeviceName (LPSTR) – 4 bytes
‘ pszPuntTarget (LPSTR) – 4 bytes
‘ dwXpress (DWORD) – 4 bytes
‘ dwPunt (DWORD) – 4 bytes
‘ pszHostPrinterName (LPSTR) – 4 bytes
‘ Total: 28 fields 4 bytes/field (assuming 32-bit pointers/DWORDs) + 2 8 bytes for SYSTEMTIME = 112 + 16 = 128 bytes
‘ On 64-bit systems, pointers are 8 bytes, so calculation changes.
‘ A safer approach is to define the Type and use the Len() function.
‘ Let’s define the structure here for calculation (this is a rough estimate)
‘ In a real scenario, use CopyMemory and Len(str) on obtained strings to verify sizes.
SizeOfPrinterInfo2 = 128 ‘ This is a placeholder and may need adjustment.
End Function
‘ — Placeholder for SYSTEMTIME structure (needed for full PRINTER_INFO_2 definition) —
‘ Private Type SYSTEMTIME
‘ wYear As Integer
‘ wMonth As Integer
‘ wDayOfWeek As Integer
‘ wDay As Integer
‘ wHour As Integer
‘ wMinute As Integer
‘ wSecond As Integer
‘ wMilliseconds As Integer
‘ End Type
‘ — Placeholder for PRINTER_INFO_2 structure —
‘ This is a simplified representation. Real implementation requires careful pointer handling.
Private Type PRINTER_INFO_2
pszDriverName As LongPtr
pszDatatype As LongPtr
pszPrintProcessor As LongPtr
pszLocation As LongPtr
pszComment As LongPtr
pszStatus As LongPtr
dwStatus As Long
dwAttributes As Long
dwPriority As Long
dwDefaultPriority As Long
‘ SYSTEMTIME structures would follow here, taking up 16 bytes each.
‘ For simplicity, we’re omitting them in this simplified type definition.
‘ pszSepFile As LongPtr
‘ pszColorProfiles As LongPtr
‘ pszPaperSizes As LongPtr
‘ pszPaperSizeDefault As LongPtr
‘ pszFormNames As LongPtr
‘ pszFormSizesDefault As LongPtr
‘ dwEnvironment As LongPtr
‘ pszPortName As LongPtr
‘ pszMonitorName As LongPtr
‘ pszDefaultSource As LongPtr
‘ dwColor As Long
‘ dwDeviceID As Long
‘ pszDirect As LongPtr
‘ pszDeviceName As LongPtr
‘ pszPuntTarget As LongPtr
‘ dwXpress As Long
‘ dwPunt As Long
‘ pszHostPrinterName As LongPtr
End Type
‘ — Helper to convert a pointer to a null-terminated string —
Private Function StrPtrToNullTermString(ByVal ptr As LongPtr) As String
Dim buffer As String
Dim i As Long
Dim charCode As Integer
If ptr = 0 Then
StrPtrToNullTermString = “”
Exit Function
End If
On Error Resume Next
‘ Read bytes until null terminator or error
Do
charCode = ReadByte(ptr + i) ‘ Read byte at current offset
If Err.Number <> 0 Then Exit Do ‘ Error reading memory
If charCode = 0 Then Exit Do ‘ Null terminator found
buffer = buffer & Chr(charCode)
i = i + 1
Loop
On Error GoTo 0
StrPtrToNullTermString = buffer
End Function
‘ — Helper to read a single byte from memory —
Private Function ReadByte(ByVal address As LongPtr) As Integer
Dim b As Byte
On Error Resume Next
CopyMemory b, ByVal address, 1
If Err.Number = 0 Then
ReadByte = AscB(b)
Else
ReadByte = -1 ‘ Indicate error
End If
On Error GoTo 0
End Function
‘ — Dummy GetPrinter function to make SetPrinter code compile —
‘ In a real scenario, this would be the actual Windows API GetPrinter.
‘ For the purpose of this example, we’ll stub it out.
If VBA7 Then
Private Declare PtrSafe Function GetPrinter Lib “winspool.drv” Alias “GetPrinterA” ( _
ByVal hPrinter As LongPtr, _
ByVal Level As Long, _
ByVal pPrinter As LongPtr, _
ByVal cbBuf As Long, _
ByRef pcbNeeded As Long) As Long
Else
Private Declare Function GetPrinter Lib “winspool.drv” Alias “GetPrinterA” ( _
ByVal hPrinter As Long, _
ByVal Level As Long, _
ByVal pPrinter As Long, _
ByVal cbBuf As Long, _
ByRef pcbNeeded As Long) As Long
End If
‘ — Dummy GlobalAlloc and GlobalFree for demonstration —
‘ In a real VBA environment, these would be PtrSafe functions.
If VBA7 Then
Private Declare PtrSafe Function GlobalAlloc Lib “kernel32” (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr
Private Declare Function GlobalFree Lib “kernel32” (ByVal hMem As LongPtr) As LongPtr
Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GPTR As Long = &H40 ‘ GMEM_FIXED
Else
Private Declare Function GlobalAlloc Lib “kernel32” (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib “kernel32” (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GPTR As Long = &H2 ‘ GMEM_FIXED (32-bit)
End If
‘ — Example Usage —
Sub TestPrinterManagement()
Dim printers As Collection
Dim printerName As Variant
‘ Get and list available printers
Set printers = GetPrinterNames()
Debug.Print “Available Printers:”
For Each printerName In printers
Debug.Print “- ” & printerName
Next printerName
‘ Set a specific printer as default (e.g., “Microsoft Print to PDF”)
‘ Replace “Microsoft Print to PDF” with an actual printer name from your system.
Dim targetPrinter As String
targetPrinter = “Microsoft Print to PDF” ‘ Example PDF printer
If printers.Count > 0 Then
‘ Try to set the default printer
If SetDefaultPrinter(targetPrinter) Then
Debug.Print “Successfully set ‘” & targetPrinter & “‘ as the default printer.”
Else
Debug.Print “Failed to set ‘” & targetPrinter & “‘ as the default printer. Check printer name and permissions.”
End If
Else
Debug.Print “No printers found on the system.”
End If
End Sub
極限の知見:
- API宣言: Windows API を使用する際は、`Declare` ステートメントで関数のシグネチャ（引数と戻り値の型）を正確に宣言する必要がある。64bit OS/VBA 環境では `PtrSafe` キーワードが必須となる。
- メモリ管理: Windows API は、C 言語のポインタを多用する。VBA からこれらの API を呼び出す場合、メモリの確保 (`GlobalAlloc`) と解放 (`GlobalFree`) を適切に行うことが極めて重要だ。メモリリークは、システム全体の不安定化を招く。
- 構造体: API が受け渡すデータ構造（例: `PRINTER_INFO_2`）は、VBA の `Type…End Type` で定義する。ただし、API が期待するメモリレイアウトと VBA の構造体が完全に一致するように、細心の注意を払う必要がある。ポインタ (`LongPtr`) と文字列の変換には、`StrPtrToNullTermString` のようなヘルパー関数が不可欠だ。
- エラーチェック: API 呼び出しの結果は、通常、成功か失敗を示す値 (0 は失敗、非ゼロは成功など) で返される。必ず返り値をチェックし、エラーが発生した場合は、`Err.LastDllError` などを参照して原因を特定する。
- 代替手段の検討: Windows API の直接呼び出しは強力だが、複雑でエラーが発生しやすい。例えば、デフォルトプリンターの設定などは、`Shell` 関数で `rundll32 printui.dll,PrintUIEntry` コマンドを実行する方が、VBA でははるかに容易で堅牢な場合がある。常に、最もシンプルで確実な方法を選択するべきだ。
5. レガシー環境の保守とシステム間連携：過去と未来を繋ぐ知恵
長年運用されているシステムには、往々にしてレガシーな技術が使われている。VB6 で書かれた COM オブジェクト、あるいは .NET Framework の古いバージョンなどだ。これらの環境で Visio VBA と連携させる場合、COM 相互運用性の理解が不可欠となる。
レガシー環境での保守:
- COM オブジェクトのラップ: レガシーな COM オブジェクトを VBA から直接利用する場合、遅延バインディング (`CreateObject` や `GetObject`) を使用すると、コンパイル時の型チェックができないため、実行時エラーのリスクが高まる。可能であれば、VB.NET などでラッパー DLL を作成し、それを参照設定して利用する方が堅牢だ。
- バージョン互換性: 古いバージョンの Visio や Office 製品との互換性を考慮する必要がある。API の挙動や利用可能な機能が異なる場合があるため、ターゲット環境での十分なテストが不可欠だ。
- パフォーマンスボトルネックの特定: レガシーシステムでは、メモリリークや非効率なアルゴリズムが原因でパフォーマンスが低下していることが多い。VBA のデバッグ機能や、Windows のパフォーマンスモニターなどを駆使して、ボトルネックを特定し、改善策を講じる必要がある。
システム間連携の極限:
- COM 相互運用: VBA は COM を通じて他のアプリケーションと連携する。この COM インターフェイスの理解が、高度な連携の鍵となる。Visio のオブジェクトモデルも COM ベースだ。
- WMI (Windows Management Instrumentation): システムの管理情報や状態を取得・設定するための標準的なインターフェイスである WMI は、VBA からも利用可能だ。これにより、他の PC のプロセスを起動したり、サービスの状態を確認したりといった、より高度なシステム管理タスクを実行できる。
- RESTful API / Web サービス: 現代的なシステム連携では、RESTful API や Web サービスが主流だ。VBA からこれらの API を呼び出すには、`MSXML2.XMLHTTP` オブジェクトや、サードパーティ製のライブラリを使用する。VB.NET や C# でクライアントアプリケーションを作成し、それを VBA から COM 経由で呼び出すというハイブリッドアプローチも有効だ。
- メッセージキュー (MSMQ): 非同期通信や、システム間の疎結合を実現するために、メッセージキューは強力な選択肢だ。VBA から MSMQ を利用することで、信頼性の高いデータ連携が可能になる。
6. パフォーマンス最適化とメモリ管理：見えない部分への徹底的なこだわり
我々が追求するのは、単に「動く」システムではない。「速く、安定して、リソースを無駄にしない」システムだ。
- オブジェクトの明示的解放 (再強調): これは何回でも強調する価値がある。特に、ループ内で生成されるオブジェクト（`Shape`, `Page`, `Selection` など）は、そのスコープを抜けたら必ず `Set obj = Nothing` する。
- 配列とコレクションの使い分け: 大量のデータを扱う場合、`Collection` よりも配列の方が一般的に高速だ。ただし、配列は固定長であるため、動的なサイズ変更が必要な場合は `ReDim Preserve` を使うか、`ArrayList` (System.Collections 名前空間) などの動的配列構造を VB.NET で作成し、COM 経由で利用することを検討する。
- `ScreenUpdating` と `EnableEvents`: VBA の処理中に画面の更新 (`Application.ScreenUpdating = False`) やイベントの発生 (`Application.EnableEvents = False`) を無効にすると、パフォーマンスが劇的に向上する。ただし、処理の完了後に必ず元に戻すことを忘れないように。
- `DoEvents` の適切な使用: 長時間実行される処理では、UI がフリーズしないように `DoEvents` を適度な間隔で呼び出す。しかし、`DoEvents` は処理の実行を一時中断させるため、多用しすぎると逆にパフォーマンスが低下する可能性がある。
- Garbage Collection (VB.NET/C#): VB.NET や C# で開発する場合、.NET のガベージコレクションがメモリ管理を自動で行ってくれる。しかし、COM オブジェクトの解放など、明示的な管理が必要な場面も依然として存在する。
まとめ：自動化の「魂」を宿す
SQL Server から取得したデータに基づき、Visio 図面を動的に生成・保存する――このプロセスは、単なるコーディング作業ではない。それは、データベースという「情報」の世界と、Visio という「表現」の世界を、我々の手で橋渡しする創造的な営みだ。
本稿で解説した ADO によるデータ取得、Visio API による図面構築、Windows API による低レベル制御、そしてレガシーシステムとの連携といった要素は、この壮大な自動化パイプラインを構築するための「道具」に過ぎない。真に重要なのは、これらの道具を使いこなし、オブジェクトのライフサイクル、リソース管理、そしてシステム全体のパフォーマンスといった、見えない部分にまで徹底的にこだわる「魂」だ。
伝説のアーキテクトとして、私は常に技術の深淵を覗き、その真髄を追求してきた。この知識が、読者の皆様が描く未来のシステム構築の一助となれば幸いだ。現場での試行錯誤、そして何よりも「なぜそうなるのか」という原理原則への探求を、これからも続けてほしい。
