こんにちは！SolidWorksの自動化の世界へようこそ。
チーフアーキテクトの私です。
「マクロの記録」ボタンを押して操作をコード化する……。確かに最初は魔法のように感じるし、入門としては最高の一歩です。でも、実務で何百枚、何千枚という図面を扱うようになると、「記録されたコードを動かしたのに、なぜか途中で固まる」「余計なファイルまで開いてしまって処理が重い」といった壁にぶつからなかったでしょうか？
特に、「何十シートもある巨大なアセンブリ図面から、外注先や検査部門に必要な『特定のシート』だけを抜き出して、別名の図面としてサクッと保存したい」という要求は、製造業の現場で本当によくあるお悩みです。
今回は、この実務直結のテーマを題材に、SolidWorks APIの裏側にある「オブジェクトのライフサイクル」や「メモリ効率の概念」を交えながら、ワンランク上のVBAプログラミングを一緒にマスターしていきましょう。ここをクリアすれば、あなたのマクロ開発スキルは間違いなく中級者の域に達しますよ！
—
1. なぜ「シートの抽出・別名保存」で つまずくのか？
マクロの記録だけでこの処理を作ろうとすると、大抵こんなコードが生成されます。
- 「現在開いている図面を別の名前で保存する」
- 「いらないシートをアクティブにして、右クリックから削除する……（あれ、削除のコードが記録されない！？）」
そう、SolidWorksの図面（DrawingDoc）において、「シートの削除」や「別ファイルへのシートの移植」は、UIの操作をそのままコード化するのが非常に難しい領域なのです。
ここでSolidWorks APIの本質を一つ。
> 「画面（UI）をマウスでカチカチ操作する手順」と、「APIに裏でデータを直接処理させる手順」は全く別物である。
不要なシートを画面上で消していくのではなく、「必要なシートだけを新品の図面にコピー（あるいは不要なシートをプログラム側で一括削除）」するというアプローチを取るのが、最も堅牢で高速なエンジニアリング手法です。
—
2. 実務で使える！特定シート抽出＆別名保存マクロ
それでは、今回のメインプログラムをお見せします。
今回は、元となる巨大図面から「指定した名前のシート」だけを新しい図面ドキュメントとして切り出し、指定フォルダに別名保存するプロシージャです。
ご自身の開発環境（VBAエディタ）にそのまま貼り付けて、パスなどを書き換えればすぐにテストできます。
Option Explicit
‘ ==============================================================================
‘ 2D図面から特定シートを抽出して別名保存するプロシージャ
‘ 前提条件: 対象の図面ファイルがSolidWorksでアクティブに開かれていること
‘ ==============================================================================
Sub ExtractAndSaveSpecificSheet()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
‘ アプリケーションとドキュメントの取得
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
‘ 安全装置：開かれているドキュメントが「図面」であるかチェック
If swModel Is Nothing Then
MsgBox “図面ファイルが開かれていません。”, vbCritical, “エラー”
Exit Sub
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox “アクティブなドキュメントは図面ではありません。”, vbCritical, “エラー”
Exit Sub
End If
Set swDraw = swModel
‘ — 設定エリア —
Dim targetSheetName As String
targetSheetName = “INSPECTION” ‘ 抽出したいシート名（例：検査用シート）
Dim saveFolderPath As String
saveFolderPath = “C:\TestOutput\” ‘ 保存先のフォルダパス（最後に必ず ‘\’ をつけてください）
‘ ——————
‘ 1. 対象シートが存在するかチェックしつつ、全シート名を取得
Dim sheetNames As Variant
sheetNames = swDraw.GetSheetNames
Dim i As Long
Dim isFound As Boolean
isFound = False
For i = LBound(sheetNames) To UBound(sheetNames)
If sheetNames(i) = targetSheetName Then
isFound = True
Exit For
End If
Next i
If Not isFound = True Then
MsgBox “指定されたシート ‘” & targetSheetName & “‘ が見つかりませんでした。”, vbExclamation, “確認”
Exit Sub
End If
‘ 2. 特定シート以外の不要シートを削除していく（後ろのシートから消すのが安全！）
‘ ※SolidWorksではシートを削除する際、インデックスのズレを防ぐために末尾から処理するのが鉄則です
Dim currentSheetName As String
For i = UBound(sheetNames) To LBound(sheetNames) Step -1
currentSheetName = sheetNames(i)
If currentSheetName <> targetSheetName Then
‘ シートの削除実行
Dim boolstatus As Boolean
boolstatus = swDraw.ActivateSheet(currentSheetName)
boolstatus = swDraw.SheetState(currentSheetName) ‘ 状態確認など
‘ APIによるシート削除
boolstatus = swDraw.DropSheet(currentSheetName)
If Not boolstatus Then
‘ 最後の1枚を消そうとした場合などのエラーハンドリング
Debug.Print “警告: シート ‘” & currentSheetName & “‘ の削除に失敗しました。”
End If
End If
Next i
‘ 3. 残った「目的のシート1枚だけになった図面」を別名で保存する
Dim originalTitle As String
Dim newFilePath As String
‘ 元のファイル名から拡張子を除いた部分を利用する場合の処理
originalTitle = swModel.GetTitle
‘ 拡張子(.slddrwなど)を取り除く簡易処理
If InStr(originalTitle, “.”) > 0 Then
originalTitle = Left(originalTitle, InStrRev(originalTitle, “.”) – 1)
End If
newFilePath = saveFolderPath & originalTitle & “_” & targetSheetName & “.slddrw”
‘ 別名保存の実行（引数: ﾊﾟｰｽ, ﾊﾞｰｼﾞｮﾝ, ｵﾌﾟｼｮﾝ）
Dim errors As Long
Dim warnings As Long
‘ 注意：上書き保存にならないよう、既存ファイルを強制保存（SaveAs3を使用）
boolstatus = swModel.Extension.SaveAs3(newFilePath, 0, 2, Nothing, Nothing, errors, warnings)
If boolstatus Then
MsgBox “正常に抽出・保存が完了しました！” & vbCrLf & newFilePath, vbInformation, “完了”
Else
MsgBox “保存に失敗しました。エラーコード: ” & errors, vbCritical, “保存エラー”
End If
End Sub
—
3. コードのキモ：ここが分かればプロ級！
上記のコードで、中級者を目指すあなたにぜひ知ってほしい「SolidWorks APIの設計思想」が3つあります。ここを理解すると、エラーに怯えない強いコードが書けるようになります。
① 型安全なドキュメントチェック（`swModel.GetType`）
VBAでありがちなのが、「ユーザーがパーツを開いている状態でマクロを実行し、メソッドが見つからずに実行時エラーで強制終了する」という事故です。
`swModel.GetType <> swDocDRAWING` で厳密に図面以外を弾くことで、プロフェッショナルな安定性を担保しています。
② なぜ「後ろのシートから削除（Step -1）」するのか？
配列やシートコレクションをループで回すとき、前から順に削除していくと、インデックス（番号）がズレてバグや予期せぬクラッシュの温床になります。
これはUI操作でもAPI操作でも共通の鉄則ですが、「複数のアイテムを削除・処理する場合は、末尾（後ろ）から逆順に処理する（Step -1）」。このセオリーを守るだけで、メモリ違反系の不可解なエラーを劇的に減らすことができます。
③ 最新の安全な保存メソッド `SaveAs3`
古いサンプルコードだと `SaveAs` が使われていることが多いですが、現代のSolidWorks VBAでは、拡張されたファイル保存メソッドである `SaveAs3` を使うのがベストプラクティスです。保存時のオプションやエラーハンドリングを細かく制御できるため、業務での自動化において「気づいたら保存できていなかった」という最悪の事態を防げます。
—
4. 陥りやすい罠とアドバイス
実際にこのコードをテストするとき、いくつかの「罠」にハマることがあります。先輩からのアドバイスとして先回りしてお伝えしておきますね。
- 罠1: 「元の図面が上書きされてしまう恐怖」
- 上記のコードは、アクティブな図面から「いらないシートを消して」、それを「別名で保存」しています。つまり、そのまま何もしないと元の図面もシートが消えた状態で上書き保存されてしまいます。
- 実務で使う際は、処理の最初に `swApp.CopyDocument` などを使ってファイルを一時的に複製するか、処理後に「変更を保存せずに閉じる（`swApp.CloseDoc`）」などの安全策を講じてくださいね。
- 罠2: フォルダパスの存在確認
- `C:\TestOutput\` のようなフォルダが存在しない場合、`SaveAs3` は容赦なくエラーを吐きます。実務コードにする際は、事前に `Dir` 関数などを使ってフォルダの有無をチェックし、無ければ自動作成するロジック（`MkDir`）を挟むと、ユーザーから神扱いされるツールになります。
—
まとめ
今回は「複数シートを持つ大規模図面からの特定シート抽出と別名保存」という、実務で絶対に直面する課題を解決するコードと、その裏側にあるエンジニアリング思想を解説しました。
「画面の操作をそのまま記録する」段階を卒業し、「APIがデータをどう処理しているか」を意識できるようになると、SolidWorks VBAで見えないものはなくなっていきます。
ぜひ今回のコードをベースに、ご自身の職場のルールに合わせてカスタマイズしてみてください。「ここをこう変えたいんだけど、どうすればいい？」という疑問があれば、いつでもまた私を頼ってくださいね。あなたの自動化ライフを心から応援しています！
