Excel VBA

【Excel VBA】【マクロ】【Tips】画像自動取り込み&サイズ自動調整マクロ(アルバム作成マクロ)

こんにちは!Lenocoです。本日も見てくださりありがとうございます。

今回は画像取り込みについてのTips回です!!!

昔々、私が事務の仕事をしていた時、社内でVBAの勉強会というものをやっていました。
こちらのマクロは、その時の課題の一個だったのですが、面白い機能ということと、
アレンジすればアルバムのように使えるのでは!?と思い、
ご紹介させていただくことにしました。

アルバム作成マクロを作る

まず、マクロの動作順序は以下の通りです。

①「Click」のセル範囲をクリックする
②画像を選択
③選択した画像が選択した範囲内にサイズを自動調整され出力される
④画像の情報や、タイトルを手入力する
⑤「PDF」ボタンを押す
⑥印刷範囲がPDFで保存される
以上

という動きになります。

マクロは以下の2つを組み合わせています。
1.画像取り込み&画像サイズ自動調整
コード記述場所:Worksheet_SelectionChangeイベントプロシージャ
2.PDFの作成&保存
コード記述場所:Module内

下準備

コードを書く前にシートの下準備が必要となります。
1.シートに縦18セル、横7セルのセル範囲をセル結合しておく
サンプルでは、B4セルからH21セル、F23からL40、B42からH59としています。
セル幅をちょうどよいサイズに調整しておいてください。
※「Click」は分かりやすいように入力していますが、無くても動きます。

2.画像情報記入用図形(角丸四角形吹き出し)とPDF出力用図形(角丸四角形)を配置
図形のループの際、この2種類の図形だった場合何も処理しない、という制御をしています。
※図形を変える場合はコードも変更してくださいね。

3.タイトル入力用のセルに罫線もしくは色をつけておく
サンプルでは罫線を設定しており、O2セルとしています。

4.印刷範囲を設定
改ページプレビューにして、印刷範囲を設定してください。
タイトル部分や「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

COMMENT

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です