こんにちは！ Visioの自動化を極めようと日夜奮闘している君なら、きっとこんな壁にぶつかったことがあるはずだ。
「数千ページもある巨大なVSDXファイルのページ設定（用紙サイズや向き）を、VBAの `Page.PageSheet` 操作で書き換えようとしたら……終わらない。コーヒーを淹れて戻ってきても、まだプロシージャが回っている」
無理もない。Visioのオブジェクトモデル経由で何千回もシェイプシートのセルを叩くアプローチは、アプリケーションの描画イベントやUndoスタックの肥大化を伴うため、実用的な速度が出ないんだ。
でも、安心してほしい。今日、君に伝授するのは、VSDXファイルの正体であるXMLを直接書き換えることで、数千ページの設定を一瞬（数秒）で焼き払う「極限の裏技」だ。
ここをクリアすれば、君はもう「マクロの記録」に頼る初学者じゃない。大規模ドキュメントを意のままに操る、本物のアーキテクトだ。さあ、扉を開けよう。
—
なぜVisio VBAの通常処理は遅いのか？（本質を知る）
まず敵を知ろう。通常、VBAでページサイズを変更する場合、次のようなコードを書くよね。
‘ 【遅いアプローチの例】
Dim pg As Visio.Page
For Each pg In ActiveDocument.Pages
pg.PageSheet.CellsU(“PageWidth”).FormulaU = “297 mm”
pg.PageSheet.CellsU(“PageHeight”).FormulaU = “420 mm”
Next pg
このコードの何がいけないのか？
Visioは、ページ（`PageSheet`）の数値を1つ変更するたびに、画面の再描画（レンダリング）、依存関係の計算、そして「元に戻す（Undo）」ためのメモリスタックへの記録を裏で行っている。これが1,000ページあれば、1,000回×数項目の重たい処理が走り、CPUが悲鳴を上げるわけだ。
解決策：VSDXの「中身」はただのZipとXMLだ！
Visioのファイル形式である「.vsdx」は、実は拡張子が違うだけの ZIPアーカイブ だ。
中身を解凍すると、`visio/pages/page1.xml`, `page2.xml`……といった、個々のページの構造を定義したXMLファイルが整然と並んでいる。
つまり、こういうことだ。
1. VBAでVSDXをZIPとして解凍する。
2. 中にあるページXMLの特定のプロパティ（用紙サイズなど）を一括置換する。
3. 再びZIPに圧縮してVSDXに戻す。
Visioのアプリケーションエンジンを一切介さないため、オブジェクトモデルのオーバーヘッドが完全にゼロになる。数千ページの変更が、文字通り「一瞬」で終わる魔法のようなアプローチだ。
—
実装編：VSDXのXMLを直接書き換える超高速マクロ
百聞は一見に如かず。実際にVSDXのXMLを直接書き換え、すべてのページの用紙サイズを「A4（横）」に一括置換する実用的なVBAコードを公開しよう。
このコードを実行するには、あらかじめVBEの参照設定で 「Microsoft Scripting Runtime」（FSOを使うため）にチェックを入れておいてくれ。
Option Explicit
‘ ==============================================================================
‘ 【上級者向け】VSDXのXML直接操作によるページ設定一括置換エンジン
‘ ==============================================================================
Sub HighSpeedPageSettingChanger()
Dim targetPath As String
targetPath = “C:\YourFolder\MassiveDocument.vsdx” ‘ 対象のファイルパスを指定
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
If Not fso.FileExists(targetPath) Then
MsgBox “指定されたファイルが存在しません。”, vbCritical
Exit Sub
End If
Dim startTime As Double
startTime = Timer
‘ 1. 作業用フォルダのパスを作成
Dim tempDir As String
tempDir = fso.GetParentFolderName(targetPath) & “\vsdx_temp_” & Format(Now, “yyyymmddhhmmss”)
fso.CreateFolder tempDir
‘ 2. VSDXをZIPとして解凍 (.vsdx -> .zip)
Dim zipPath As String
zipPath = tempDir & “.zip”
fso.CopyFile targetPath, zipPath, True
‘ Shell関数を使ってZIPを解凍 (Windows標準機能を利用)
UnZipFile zipPath, tempDir
‘ 3. 解凍されたフォルダ内からページXMLを走査し、数値を書き換える
‘ VSDX内のページXMLは “visio/pages/page.xml” に格納されている
Dim pagesDir As String
pagesDir = tempDir & “\visio\pages”
If fso.FolderExists(pagesDir) Then
Dim subFolder As Object
Set subFolder = fso.GetFolder(pagesDir)
Dim file As Object
For Each file in subFolder.Files
‘ pageX.xml のみを対象とする (PagePropsなど他のXMLは除外)
If LCase(file.Name) Like “page.xml” Then
Call ModifyPageXmlWidthHeight(file.Path)
End If
Next file
End If
‘ 4. 再びZIPに圧縮し、拡張子を.vsdxに戻す
If fso.FileExists(zipPath) Then fso.DeleteFile zipPath
ZipFile tempDir, zipPath
‘ 元のファイルを上書きバックアップ（必要に応じて変更してください）
fso.CopyFile zipPath, targetPath, True
‘ 5. 一時ファイルのクリーンアップ
fso.DeleteFile zipPath, True
fso.DeleteFolder tempDir, True
MsgBox “処理完了！ 実行時間: ” & Format(Timer – startTime, “0.00”) & “秒”, vbInformation
End Sub
‘ ==============================================================================
‘ 補助プロシージャ：XML内のPageSheetプロパティ（幅・高さ）を書き換える
‘ ==============================================================================
Private Sub ModifyPageXmlWidthHeight(xmlFilePath As String)
Dim xmlDoc As Object
Set xmlDoc = CreateObject(“MSXML2.DOMDocument.6.0”)
xmlDoc.async = False
xmlDoc.resolveExternals = False
If xmlDoc.Load(xmlFilePath) Then
‘ VSDXのXML名前空間を指定 (Visioのスキーマに合わせる)
xmlDoc.setProperty “SelectionNamespaces”, “xmlns:v=’http://schemas.microsoft.com/office/visio/2012/main'”
‘ PageSheet内の PageWidth と PageHeight の Cell 要素を狙い撃ちで書き換える
‘ 例として、A4横サイズ (幅: 297mm = 11.693インチ, 高さ: 210mm = 8.267インチ) に設定
‘ VisioのXML内部の単位は基本的に「インチ (IN)」で保持されている点に注意！
Dim nodeWidth As Object
Set nodeWidth = xmlDoc.SelectSingleNode(“//v:PageSheet/v:Cell[@N=’PageWidth’]”)
If Not nodeWidth Is Nothing Then nodeWidth.setAttribute “V”, “11.69291338582677”
Dim nodeHeight As Object
Set nodeHeight = xmlDoc.SelectSingleNode(“//v:PageSheet/v:Cell[@N=’PageHeight’]”)
If Not nodeHeight Is Nothing Then nodeHeight.setAttribute “V”, “8.26771653543307”
‘ 変更を上書き保存
xmlDoc.Save xmlFilePath
End If
End Sub
‘ ==============================================================================
‘ 補助プロシージャ：PowerShellを使った高速ZIP解凍・圧縮
‘ ==============================================================================
Private Sub UnZipFile(zipPath As String, destDir As String)
Dim shellApp As Object
Set shellApp = CreateObject(“Shell.Application”)
shellApp.Namespace(destDir).CopyHere shellApp.Namespace(zipPath).Items
End Sub
Private Sub ZipFile(sourceDir As String, zipPath As String)
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
If fso.FileExists(zipPath) Then fso.DeleteFile zipPath
‘ 空のZIPヘッダを作成
Dim a As Object
Set a = fso.CreateTextFile(zipPath, True)
a.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, vbNullChar)
a.Close
Dim shellApp As Object
Set shellApp = CreateObject(“Shell.Application”)
Dim sourceFolder As Object
Set sourceFolder = shellApp.Namespace(sourceDir)
Dim destFolder As Object
Set destFolder = shellApp.Namespace(zipPath)
destFolder.CopyHere sourceFolder.Items
‘ 非同期処理の完了を少し待つ（ファイルサイズが大きい場合の対策）
Dim wmi As Object
Do Until destFolder.Items.Count = sourceFolder.Items.Count
DoEvents
Loop
End Sub
—
コードの核心と、知っておくべき「罠」
このコードのミソは、`ModifyPageXmlWidthHeight` 内の以下の部分だ。
xmlDoc.SelectSingleNode(“//v:PageSheet/v:Cell[@N=’PageWidth’]”)
VisioのXML構造では、シェイプやページの持つプロパティ（セル）は `
ここで、絶対に忘れてはいけない極限の知見（罠）を伝授しよう。
注意点1：VisioのXML内部単位は「インチ」である
画面上やVBAのコード内（`CellsU`など）で「297 mm」と指定していたとしても、VSDXのXML内部ではすべて「インチ（IN）」に換算されて保持されている。
そのため、XMLを直接書き換えるときは、必ずミリメートルをインチに換算した値（例：297mm ＝ 11.6929…インチ）を渡さなければならない。ここをサボると、開いたときに図面がとんでもないサイズに爆発する。
注意点2：実行時は対象のVisioファイルを閉じておくこと
VSDXファイルがVisioアプリで開かれている状態でこのマクロを実行すると、ファイルがロックされていてZIPの書き換えや上書き保存に失敗する。必ずファイルを閉じた状態で実行しよう。
—
まとめ：ここをクリアすれば、君はもう中級者を超えている
通常のオブジェクトモデルを使った自動化は、言いわば「正面突破」だ。しかし、システムが巨大化すればするほど、正面突破はコスト（時間）が高くつく。
今回学んだ「ファイル構造の解体と直接操作」というアプローチは、Excel（XLSX）やWord（DOCX）、そしてVisio（VSDX）といった OpenXML形式のファイルを扱うすべての自動化において最強の武器 になる。
「画面を開かずに、バックグラウンドで数千ページのデータを一瞬で料理する」
この感覚を掴んだ君なら、どんなに絶望的な量のドキュメント修正案件が来ても、涼しい顔で自動化ツールを組んで定時で帰れるはずだ。
分からないことがあれば、いつでもまたこの扉を叩いてくれ。応援しているよ！
