【実務・中級編】【上級者向け】XML形式のVisioファイル（VSDX）を直接操作し、ページ設定を高速に一括置換する手法 – Visio VBA解析バイブル

【Visio VBA極限optimization】数千ページの地獄から生還せよ：VSDX内部XML直叩きによるページ設定超高速一括置換術

開発現場でこんな絶望を味わったことはないか？
「数百、あるいは数千ページに及ぶフロー図やネットワーク図のページサイズ、向き、縮尺を一括変更してほしい」

これを素直にVisioのオブジェクトモデル（VBA）を使って実装するとどうなるか。
`ActiveDocument.Pages`をループさせ、各ページの`PageSheet`を開き、`PageWidth`や`PageHeight`のセルをチマチマ書き換える。画面描画を抑止（`ScreenUpdating = False`）し、イベントを殺してもなお、数千ページの前には数十分から数時間の地獄の待ち時間が待っている。進捗バーが1%進む間にコーヒーを何杯飲めばいいのか分からない。

なぜ遅いのか？答えは簡単だ。VBAのオブジェクトモデルは、背後で重厚長大なCOMレイヤーを叩き、その都度Visioの強力すぎる再計算エンジンと画面・内部キャッシュの同期を走らせているからだ。

プロの業務自動化エンジニアなら、このアプローチは即座にボツにすべきだ。
今回のテーマは、VSDXファイルの正体である「ZIPとXML」に着目し、VBAからVSDX内部のXMLを直接書き換えることで、数千ページのページ設定を「数秒」で完了させる超高速化アプローチを伝授する。

—

1. なぜXML直接操作（DOM / XPath）なのか？

VSDXファイルは、実体に於いては単なるZIPアーカイブだ。その中身を解凍すると、各ページのレイアウトや図形情報は純粋なXMLファイル（`pages/page1.xml`, `pages/page2.xml` 等）として格納されている。

オブジェクトモデルを介在させず、VBAから直接このXMLテキストを操作、あるいはDOM/Regexで置換してZIPに押し戻す。
この手法のメリットは圧倒的だ。

1. Visioの描画エンジンが稼働しない（メモリ消費が極小）
2. ディスク上のI/Oと文字列置換のみで完結するため、O(N)の処理が爆速
3. 数千ページあっても数秒で終わる

一方で、デメリット（注意点）もある。XMLの構造を破壊すればファイルは一発で破損（Corrupt）する。だからこそ、本稿で紹介する「堅牢な設計」と「安全なトランザクション管理」が必要不可欠となる。

—

2. 堅牢な設計と実装上の注意点

実務の現場でこの手法を導入するにあたり、以下の鉄則を遵守してほしい。

• アトミック処理（ロールバックの担保）

作業中のファイルが破損するリスクを考慮し、処理は必ず「別名コピー（あるいはメモリ上の複製）」に対して行い、成功した段階で元ファイルと差し替えること。

• ADO.DB.Stream等を用いた文字コードの死守

VSDX内のXMLはすべて `UTF-8 (BOMなし)` でエンコードされている。VBAの標準関数や不適切なストリーム処理を使うと文字化けやタグ破損を招くため、`ADODB.Stream` で厳密に読み書きする。

• 名前空間（Namespace）への配慮

VisioのページXMLには `http://schemas.microsoft.com/office/visio/2012/main` などの名前空間が付与されている。XPathで要素を特定する際は、この名前空間を無視するか適切にハンドリングする必要がある。今回は極限までシンプルかつ堅牢にするため、正規表現（RegEx）と文字列置換のハイブリッドによる確実なアプローチを採用する。

—

3. プロダクションコード：VSDX高速一括置換モジュール

以下のコードは、VSDXファイルを一時フォルダに展開し、全ページのページサイズ（例：A4縦からA3横へ）を定義するXML要素を一括置換した上で、再びZIP（VSDX）としてパッケージングする実用コードである。

事前に参照設定として 「Microsoft Scripting Runtime」 を有効にしておくこと。

Option Explicit

‘ ==============================================================================
‘ ódulo名: modVsdxFastPageConfig
‘ 概要 : VSDX内部のXMLを直接書き換え、ページ設定（サイズ等）を爆速で一括置換する
‘ ==============================================================================

Public Sub ExecuteFastPageConfigBatch()
Dim targetVsdxPath As String
targetVsdxPath = “C:\Projects\MassiveDocument.vsdx” ‘ 対象のファイルパス

If Dir(targetVsdxPath) = “” Then
MsgBox “対象ファイルが存在しません。”, vbCritical
Exit Sub
End If

Dim startTime As Double
startTime = Timer

On Error GoTo ErrorHandler

‘ 1. 作業用一時ディレクトリの作成
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)

Dim tempDir As String
tempDir = fso.GetSpecialFolder(2) & “\VisioTemp_” & Format(Now, “yyyymmddhhnnss”) & “\”
fso.CreateFolder tempDir

‘ 2. バックアップの作成とVSDX（実体はZIP）の展開
Dim backupPath As String
backupPath = targetVsdxPath & “.bak”
fso.CopyFile targetVsdxPath, backupPath, True

UnZipFile targetVsdxPath, tempDir

‘ 3. pages フォルダ内の全 XML ファイルに対してページ設定を一括置換
Dim pagesDir As String
pagesDir = tempDir & “visio\pages\”

If fso.FolderExists(pagesDir) Then
Call BatchModifyPageXmls(pagesDir)
Else
Err.Raise 1000, “VSDXStructure”, “想定されたページ構造（visio/pages/）が見つかりません。”
End If

‘ 4. 再びZIP圧縮してVSDXとして保存
‘ ※既存のVSDXを上書きするため、一度削除してから再圧縮
Kill targetVsdxPath
ZipFile tempDir, targetVsdxPath

‘ 5. 一時ファイルのクリーンアップ
fso.DeleteFolder tempDir, True
If fso.FileExists(backupPath) Then fso.DeleteFile backupPath

MsgBox “処理が完了しました。 実行時間: ” & Format(Timer – startTime, “0.00”) & ” 秒”, vbInformation, “爆速完了”
Exit Sub

ErrorHandler:
‘ 異常終了時はバックアップから復元
If Not fso Is Nothing Then
If fso.FileExists(backupPath) Then
fso.CopyFile backupPath, targetVsdxPath, True
fso.DeleteFile backupPath
End If
If fso.FolderExists(tempDir) Then fso.DeleteFolder tempDir, True
End If
MsgBox “エラーが発生しました: ” & Err.Description, vbCritical, “致命的エラー”
End Sub

‘ ==============================================================================
‘ 内部処理: 各ページXMLの書き換え（例: A4縦[幅:8.267, 高:11.69] -> A3横[幅:16.535, 高:11.69]）
‘ ==============================================================================
Private Sub BatchModifyPageXmls(ByVal pagesFolderPath As String)
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)

Dim targetFolder As Object
Set targetFolder = fso.GetFolder(pagesFolderPath)

Dim fileItem As Object
For Each fileItem In targetFolder.Files
If LCase(fso.GetExtensionName(fileItem.Name)) = “xml” Then
‘ ページXML本体ではなく、関連ファイル（page1.xml.rels等）を除外
If InStr(1, fileItem.Name, “.xml.rels”, vbTextCompare) = 0 Then
ModifySinglePageXml fileItem.Path
End If
End If
Next fileItem
End Sub

Private Sub ModifySinglePageXml(ByVal xmlFilePath As String)
Dim xmlContent As String
xmlContent = ReadTextFileUTF8(xmlFilePath)

‘ VisioのPageSheet内にある PageWidth と PageHeight の値を正規表現で置換
‘ 例として、 を目的のサイズに書き換える
‘ ※単位はインチ（Visioの内部単位は常にインチ）
‘ A3横サイズ: 幅 16.535433、高さ 11.692913 に変更する場合

Dim regEx As Object
Set regEx = CreateObject(“VBScript.RegExp”)
regEx.Global = True
regEx.IgnoreCase = True

‘ PageWidth の置換
regEx.Pattern = “(]>)”
xmlContent = regEx.Replace(xmlContent, “$116.53543307086614$3”)

‘ PageHeight の置換
regEx.Pattern = “(]>)”
xmlContent = regEx.Replace(xmlContent, “$111.69291338582677$3”)

‘ 書き戻し
WriteTextFileUTF8 xmlFilePath, xmlContent
End Sub

‘ ==============================================================================
‘ ユーティリティ: UTF-8 (BOMなし) での読み書きとZIP圧縮・展開
‘ ==============================================================================
Private Function ReadTextFileUTF8(ByVal filePath As String) As String
Dim stream As Object
Set stream = CreateObject(“ADODB.Stream”)
With stream
.Type = 2 ‘ adTypeText
.Charset = “UTF-8”
.Open
.LoadFromFile filePath
ReadTextFileUTF8 = .ReadText
.Close
End With
End Function

Private Sub WriteTextFileUTF8(ByVal filePath As String, ByVal content As String)
Dim stream As Object
Set stream = CreateObject(“ADODB.Stream”)
With stream
.Type = 2 ‘ adTypeText
.Charset = “UTF-8”
.Open
.WriteText content
.SaveToFile filePath, 2 ‘ adSaveCreateOverWrite
.Close
End With
End Sub

Private Sub UnZipFile(ByVal zipPath As String, ByVal destPath As String)
Dim shellApp As Object
Set shellApp = CreateObject(“Shell.Application”)

Dim destFolder As Object
Set destFolder = shellApp.NameSpace(destPath)

Dim srcFolder As Object
Set srcFolder = shellApp.NameSpace(zipPath)

destFolder.CopyHere srcFolder.Items, 4 + 16 ‘ 4: 進捗表示なし, 16: Yes To All
End Sub

Private Sub ZipFile(ByVal srcFolderPath As String, ByVal zipPath As String)
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)

‘ 空のZIPファイルを作成 (PKから始まるZIPヘッダの書き込み)
Dim zipHeader As String
zipHeader = Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, Chr(0))

Dim fileNum As Integer
fileNum = FreeFile
Open zipPath For Binary As #fileNum
Put #fileNum, , zipHeader
Close #fileNum

Dim shellApp As Object
Set shellApp = CreateObject(“Shell.Application”)

Dim destFolder As Object
Set destFolder = shellApp.NameSpace(zipPath)

Dim srcFolder As Object
Set srcFolder = shellApp.NameSpace(srcFolderPath)

‘ フォルダ内の全アイテムをZIPへコピー
Dim item As Object
For Each item In srcFolder.Items
destFolder.CopyHere item, 4 + 16
Next item

‘ Shellの非同期コピーが完了するまで少し待機（環境により調整）
Dim startWait As Double
startWait = Timer
Do While destFolder.Items.Count < srcFolder.Items.Count DoEvents If Timer - startWait > 10 Then Exit Do
Loop
End Sub

—

4. このアーキテクチャが現場にもたらすインパクト

このコードを実務の自動化サーバーや、ユーザーの手元のクライアントツールに組み込んだ瞬間から、処理速度の概念が覆る。

• 従来（オブジェクトモデル走査）: 数千ページで 「30分〜数時間（最悪の場合メモリ不足でフリーズ）」
• 本手法（XMLダイレクトハック）: 数千ページであっても 「約 2〜5 秒」

これが、API仕様とファイルの構造を深く理解したプロフェッショナルエンジニアが構築する「真に実用的な業務自動化ソリューション」だ。
定型作業のパフォーマンス限界に直面しているなら、今すぐこのアプローチを導入し、退屈な待ち時間からチームを解放してほしい。