こんにちは！Lenocoです。本日も見てくださりありがとうございます。
今回は画像取り込みについてのTips回です！！！
昔々、私が事務の仕事をしていた時、社内でVBAの勉強会というものをやっていました。
こちらのマクロは、その時の課題の一個だったのですが、面白い機能ということと、
アレンジすればアルバムのように使えるのでは！？と思い、
ご紹介させていただくことにしました。
アルバム作成マクロを作る
まず、マクロの動作順序は以下の通りです。
①「Click」のセル範囲をクリックする
②画像を選択
③選択した画像が選択した範囲内にサイズを自動調整され出力される
④画像の情報や、タイトルを手入力する
⑤「PDF」ボタンを押す
⑥印刷範囲がPDFで保存される
以上
という動きになります。
マクロは以下の2つを組み合わせています。
１．画像取り込み＆画像サイズ自動調整
コード記述場所：Worksheet_SelectionChangeイベントプロシージャ
２．PDFの作成＆保存
コード記述場所：Module内
下準備
コードを書く前にシートの下準備が必要となります。
１．シートに縦18セル、横7セルのセル範囲をセル結合しておく
サンプルでは、B4セルからH21セル、F23からL40、B42からH59としています。
セル幅をちょうどよいサイズに調整しておいてください。
※「Click」は分かりやすいように入力していますが、無くても動きます。
２．画像情報記入用図形（角丸四角形吹き出し）とPDF出力用図形（角丸四角形）を配置
図形のループの際、この2種類の図形だった場合何も処理しない、という制御をしています。
※図形を変える場合はコードも変更してくださいね。
３．タイトル入力用のセルに罫線もしくは色をつけておく
サンプルでは罫線を設定しており、O2セルとしています。
４．印刷範囲を設定
改ページプレビューにして、印刷範囲を設定してください。
タイトル部分や「PDF」のボタンが入らないようにすると良いと思います。
↓こんなイメージです。
画像取り込み＆画像サイズ自動調整のコードは、上記で下準備をしたシートに記述します。
VBEを開き、該当のシートをダブルクリックします。
左上のプルダウンが「（General）」となっているかと思うので、これを「Worksheet」にします。
右上のプルダウンが「SelectionChange」に勝手に切り替わりSubステートメントが出力されます。
右上プルダウンからいろいろなイベントが選択できますが、今回はこの「SelectionChange」がイベントとなるのでこのままでOKです。
ワークシートで選択範囲を変更したときにこの「SelectionChange」イベントが呼び出されます。
それではコードを見ていきましょう。
コード（画像取り込み＆画像サイズ自動調整）
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dlgAnswer As Boolean
Dim sha As Shape
Dim myWidth As Single
Dim myHeight As Single
If Target.Columns.Count = 7 And Target.Rows.Count = 18 Then
myWidth = Target.Width
myHeight = Target.Height
dlgAnswer = Application.Dialogs(xlDialogInsertPicture).Show
If dlgAnswer Then
For Each sha In ActiveSheet.Shapes
If sha.AutoShapeType <> msoShapeRoundedRectangularCallout And sha.AutoShapeType <> msoShapeRoundedRectangle And (Not sha.AlternativeText Like "*サイズ調整済み*") Then
With sha
.LockAspectRatio = msoTrue 'サイズを変更しても元の比率を保持する
If .Width > myWidth Then
.Width = myWidth - 2
End If
If .Height > myHeight Then
.Height = myHeight - 2
End If
'横位置調整
.Left = .Left + (myWidth - .Width) / 2
'縦位置調整
.Top = .Top + (myHeight - .Height) / 2
'代替テキスト
.AlternativeText = .AlternativeText & "サイズ調整済み"
End With
End If
Next
End If
End If
End Sub
コードの説明
シート上のセルを選択すると、Worksheet_SelectionChangeイベントが呼び出されます。
変数を宣言します。
boolean型の変数「dlgAnswer」は「Application.Dialogs」コレクションの「Show」メソッドの戻り値を入れるのに使用します。
正しく画像が選択された場合は「True」、キャンセルされた場合は「False」が入ります。
Shape型の「sha」はシート上の図形を入れます。
Single型の「myWidth」「myHeight」は、セル範囲の縦横のサイズを入れます。小数点以下が入る可能性があるため、整数が入るLong型ではなくSingle型としています。
最初のIf文です。
選択されたセルの行数、列数を確認します。Worksheet_SelectionChangeイベントの引数「Target」を使って確認ができます。
行数が18、列数が7であればIf文に入ります。
事前の準備で正しくセル結合ができていればIf文に入るはずです！
続いて、選択セルの行幅、列幅を変数に格納します。
「Application.Dialogs」コレクションの「Show」メソッドを使い、画像の挿入をします。
引数に「xlDialogInsertPicture」を設定し、図の挿入のダイアログボックスを表示できます。
正しく図形が選択された場合は「dlgAnswer」に「True」が入り、ダイアログボックスでキャンセルされた場合は「False」が入ります。
次のIf文は「dlgAnswer」が「True」だった場合のみ入ります。「False」だった場合は、処理を終了します。
続いて、図形のループに入ります。
シート上全ての図形をループしますが、For文の中のIf文の条件に一致する場合のみ画像サイズ自動調整の処理を行います。
If文の条件は以下です。すべての条件を満たしているときにIf文に入ります。
・図形種類が「角丸四角形吹き出し」でない
・図形種類が「角丸四角形」でない
・代替テキストの「説明」に「サイズ調整済み」という文言が含まれていない
上記の条件により、画像情報記入用図形とPDF出力用の図形、一度サイズ調整が行われた画像は処理の対象ではなくなります。
※代替テキストについては「なにこれ？」という状態かと思いますが、後で説明がありますので少々お待ちください！
図形の設定をしていきます。
「With」を使用し、以降の「sha」の記述を省略しています。
※Withについてより詳しく知りたい方は過去のブログ「Withとオブジェクト変数を使ってコードを見やすくシンプルに！」をご確認ください。
「Shape」の「LockAspectRatio」プロパティに「msoTrue」を入れると、画像サイズの元の比率を保持することができます。
続いて縦横のサイズ調整の処理をします。
画像の横幅が選択セルの横幅より大きい場合、選択セルの横幅マイナス2ピクセルしたものを画像の横幅に設定します。
画像の縦幅が選択セルの縦幅より大きい場合、選択セルの縦幅マイナス2ピクセルしたものを画像の縦幅に設定します。
このマイナス2ピクセルというのは、画像のサイズを選択セルの幅いっぱいにするのではなく、枠を少し残したいというデザイン的な事情でマイナス2ピクセルしています。
続いて、選択セルの真ん中に画像が来るように横位置と縦位置を調整します。
そして最後に画像の代替テキストに「サイズ調整済み」という文言を追加します。
最後にこの処理を行うことで、一度画像の自動調整をした画像は再度If文には入らなくなるため、追加した新規の画像のみに処理を実行するようになります。
続いてPDFの作成＆保存のコードですが、通常のModule内に記述します。
VBEを開き、ファイル上で右クリック→「挿入」→「標準モジュール」でModuleを追加します。
そして以下のコードを記述してください。
コード（PDFの作成＆保存）
Sub SaveAsPDF()
Dim fileName As String
Dim filePath As String
Dim mySheet As Worksheet
Const TITLE_CELL As String = "O2"
Set mySheet = ActiveSheet
If mySheet.Range(TITLE_CELL) <> "" Then
fileName = mySheet.Range(TITLE_CELL) & ".pdf"
Else
fileName = mySheet.name & ".pdf"
End If
filePath = ThisWorkbook.Path & "\" & fileName
mySheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath
MsgBox "ファイル出力完了！(*'∀'*)"
End Sub
コードの説明
変数を宣言します。
ファイル名やファイルパスを入れるString型の変数、シートを格納するWorksheet型の変数を用意します。
続いて、定数を宣言します。
※事前の準備でPDFタイトルを設定するセルを「O2」に設定していると思いますが、もし別のセルにしている方はその該当のセルを定数として設定してください。
アクティブシートを変数に設定します。
次に、PDFファイルのファイル名の設定です。
タイトルの設定セルが空でなければ、それをファイル名として保存しておきます。
セルが空であれば、アクティブシートのシート名をそのままファイル名とします。
作業ファイルと同じ階層にPDFファイルを作成したいので、以下の形でPDFファイルのファイルパスを作成します。
作業ファイルのファイルパス& “\” & PDFファイル名
「ExportAsFixedFormat」メソッドを使用し、シートをPDFファイルとして出力します。
引数「Type」に「xlTypePDF」を設定し、PDFファイルを出力できます。
引数「fileName」に保存するファイルの名前を設定します。先ほど作成したファイルパスを指定します。
最後に出力完了のメッセージを表示して終了です。
まとめ
どうでしょうか？うまく動きましたか？
わたしは我が家の猫の写真を取り込んでみました！
選択セルを縦長にして縦向きの写真用にしてみるのもいいですね。
今の状態だと、1シートを1つのPDFにしかできないため、
複数シートを一つのPDFにできるようマクロを改良してよりアルバムらしくしてみるのもいいですね！
いろいろといじってみて自分好みのデザインや動きに変更してみてください。
わたしも改良してみてよりいい感じになればまたブログでお知らせします！
Lenoco
