【ファイルを保存】オートシェイプを画像ファイルで出力する

　Excelシート上で描画したオートシェイプを画像ファイルとして出力するコードを紹介します。

　報告書とかマニュアルなどの作成でイラスト画像を使う機会は多いと思います。

　イラストレータなどで作成したりしなくてもExcelには、オートシェイプという便利な機能があります。

　イラストレータとかを起動させると Windows の処理が重くなりますし、むしろシンプルなイラスト画像や略図なら使い慣れている方の多いオートシェイプで作ったほうが効率的ともいえます。

　ただオートシェイプは直接画像で出力はできないので画像として出力するには、ひと工夫する必要があります。

　今回は、それをExcelマクロで自動で行うコードを構築してみました。

Sub オートシェイプを画像ファイルで出力する()
'
' オートシェイプを画像ファイルで出力する Macro
'
'変数の宣言 ----------
Dim filPath As String
Dim sheName As String

sheName = ActiveSheet.Name 'アクティブシート名を変数 sheName に代入する。

Cells.Select

Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ActiveSheet.PasteSpecial Format:="図 (拡張メタファイル)", Link:=False, _
    DisplayAsIcon:=False
    
filePath = Application.GetSaveAsFilename(InitialFileName:="規定の名称.html", FileFilter:="Webファイル,*.html*") ' 保存のダイアログを表示 ----------

If filePath = "False" Then
    Selection.Delete
    MsgBox "キャンセルされました処理を終了します。"
    Exit Sub ' キャンセルした場合は、処理を終了する ----------
End If

' 保存する処理 ----------
filePath = filePath & "html"

'Call wb.SaveAs(filePath) ' 名前を付けて保存 ----------

'アクティブシートのA1～Z50の範囲の画像を書き出す処理 ----------
    With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
        filePath, sheName, "$A$1:$Z$50", _
        xlHtmlStatic, "Shape", "")
        .Publish (True)
        .AutoRepublish = False
    End With
    Selection.Delete ' 貼り付けた画像を削除する ----------
    Range("A1").Select
    MsgBox "オートシェイプを画像ファイルとして出力しました。"
End Sub

 　上記のコードは、Excel上でWebページとして保存する処理を利用しています。

　Webページとしての保存を行うとファイル名.files という名前のフォルダーが作成されてフォルダー内にワークシート上のオートシェイプが PNG 画像として保存されます。

　このコードは、その一連の処理を「マクロの記録」で作成し、それにオートシェイプのグループ化、保存のダイアログ表示などを追加したものです。

　それとこのコードは、注釈にもあるようにアクティブシート内についてセル範囲（A1～Z50）にあるオートシェイプしか処理できません。

　オートシェイプのある範囲を所得するコードを追加すると記述が長くなるので今回は、省略しました。

　それと画像ファイルのみを出力させようとするなら作成されたフォルダーから対象の画像をフォルダー外に移動させてその後にフォルダーを削除する処理が必要です。

　今回は、シンプルな例としてさきほどのコードを紹介しました。

　次回は、画像ファイルのみを出力し、なおかつコードの記述をコンパクトにして紹介をしたいと思います。