【超時短！】写真のサイズ変更と配置を自動で行う方法！【Excel VBA】

こんにちは！『ルウちゃんのExcel Labo』管理人の＠rouxchanblogです！

今回はこのような悩みについて解説します。

ルウちゃん

挿入した写真のサイズ変更や、配置を自動でする方法ってないの？

自動で配置できるサンプルコードの紹介

今回は「写真のサイズ変更と配置を自動で行う方法」を解説します。

このような様式に写真を自動で配置するコードを紹介します。

まずはサンプルコードと実際の画面を見て完成イメージを確認してください！

Sub 写真自動配置()
Dim targetRange As Range  '変数定義

On Error GoTo ErrLabel  'エラー処理(エラー発生時ErrLabelまでスキップ)

ActiveSheet.Pictures.Select '全ての写真を選択
Selection.ShapeRange.LockAspectRatio = msoFalse  '縦横比の固定を解除
Selection.Width = 234  '幅指定
Selection.Height = 171  '高さ指定

Set targetRange = Range("B4")  '配置セルの指定
ActiveSheet.Shapes(2).Select  '写真を選択
Selection.ShapeRange.Left = targetRange.Left  '写真の左面を配置セルに移動
Selection.ShapeRange.Top = targetRange.Top  '写真の上面を配置セルに移動
              
Set targetRange = Range("J4")
ActiveSheet.Shapes(3).Select
Selection.ShapeRange.Left = targetRange.Left
Selection.ShapeRange.Top = targetRange.Top

Set targetRange = Range("B15")
ActiveSheet.Shapes(4).Select
Selection.ShapeRange.Left = targetRange.Left
Selection.ShapeRange.Top = targetRange.Top

Set targetRange = Range("J15")
ActiveSheet.Shapes(5).Select
Selection.ShapeRange.Left = targetRange.Left
Selection.ShapeRange.Top = targetRange.Top

ErrLabel:  'エラー処理(エラー時はここまでスキップ)

End Sub

写真を挿入してから、コードを実行します。

このように自動でサイズ変更と配置を行うことができました。

次に具体的なコードの解説をしていきます。

写真のサイズを変更する方法

ActiveSheet.Pictures.Select '全ての写真を選択
Selection.ShapeRange.LockAspectRatio = msoFalse  '縦横比の固定を解除
Selection.Width = 234  '幅指定
Selection.Height = 171  '高さ指定

写真のサイズを変更するには、変更する写真を選択しなければいけません。

そこで「ActiveSheet.Pictures.Select」で全ての写真を選択します。

次に「ShapeRange.LockAspectRatio= msoFalse」と記述することで、写真のサイズ変更時の縦横比の固定を解除してあげます。

これをしないと縦と横をそれぞれ自由なサイズに変更できなくなってしまうので注意です。

ルウちゃん

縦横比の固定の解除ってかなり重要なんだね、、

最後に「Width」で幅を、「Height」で高さを指定します。

いずれも単位はポイントを使用します。1ポイントは1/72インチで、約0.35mmです。

と言ってもだいたいの数値を入力して、あとから微調整していけばいいので数値を覚える必要はありません。

写真を指定したセルに配置する方法

Dim targetRange As Range  '変数定義

Set targetRange = Range("B4")  '配置セルの指定
ActiveSheet.Shapes(2).Select  '写真を選択
Selection.ShapeRange.Left = targetRange.Left  '写真の左面を配置セルに移動
Selection.ShapeRange.Top = targetRange.Top  '写真の上面を配置セルに移動

まずは、変数を定義します。データ型は「Range型」にしてください。

この変数に配置したい場所のセルが入ることになります。

ルウちゃん

配置したいセルを変数に指定すればいいんだね。

次に、各写真を選択していきますが、ここで一つ注意しなければならないことがあります。

「Shapes(2)」はシートの中の２番目のオブジェクトを指します。

このシートには既に１つオブジェクトを配置していますので、２番目から使うことになるのです。

各写真を選択できたら、最後に「ShapeRange.Left = targetRange.Left」と記述し、指定したセルの左側に揃えて配置します。

「ShapeRange.Top = targetRange.Top」も同様に指定したセルの上面に揃えて配置することができます。

エラー発生時の対処について

このコードでは写真が４枚より少ない場合にエラーが発生してしまいます。

しかし実務では必ずしも全ての写真を貼り付ける必要のない場合もあります。

そこでエラーが発生しても処理が止まらないようにする必要があるのです。

On Error GoTo ErrLabel  'エラー処理(エラー発生時ErrLabelまでスキップ)

〜エラーが発生する可能性のある処理〜

ErrLabel:  'エラー処理(エラー時はここまでスキップ)

このように記述することで、途中でエラーが発生しても処理を継続させることができます。

具体的には「On Error GoTo ○○」と記述すると、その後エラーが発生しても「○○:」以降の処理までスキップさせることができるのです。

これは他のコードにも応用できるのでぜひ使って見てください！

よくある質問と補足情報

5枚以上写真を配置したい場合はどうすればいい？

Set targetRange = Range("※1")
ActiveSheet.Shapes(※2).Select
Selection.ShapeRange.Left = targetRange.Left
Selection.ShapeRange.Top = targetRange.Top

※1　写真を貼り付けたいセルを記述してください。

※2　オブジェクトの通し番号を記述してください。サンプルコードの続きの場合は5枚目が6になります。

5枚目以降も同じくこのコードをどんどん繋げていくことで実行できます。

実行ボタンのサイズも変更されてしまう場合はどうすればいい？

まずボタンのオブジェクト番号を確認し、VBAコードのオブジェクト番号を変更する必要があります。

「Shapes()」にボタンのオブジェクト番号ではなく、対応する写真のオブジェクト番号を記載することでボタンのサイズを変えずに実行することができます。

画像のオブジェクト番号がわからない場合はどうすればいい？

これについてはこの方法でオブジェクト一覧を開いてください。

まず「検索と選択」から「オブジェクトの選択と表示」をクリックしてください。

すると参考画像②のような画面が開けます。ここには写真、図形、テキストボックス、ボタンなどのオブジェクトを一覧で見ることができ、通し番号も確認できます。基本的には挿入した順番で1.2.3…と設定されていきます。

しかし、参考画像③のようにどれかのオブジェクトを消してまた別のオブジェクトを挿入すると、画面上は５番が振られますが内部では4番が振られています。

VBAでオブジェクトを扱う場合はこのケースに気をつけましょう。

マクロを使ってオブジェクト番号を確認する方法

画面上の番号と内部の番号が違い、わからない場合はマクロを使って確認しましょう。

Activesheet.Shapes(4).Select

サンプルコードで内部的に4番の画像を選択することができました。

このコードを使えば内部的に何番の画像かを画面上で確認することができます。

写真を自動で配置する方法のまとめ

今回は「写真のサイズ変更と配置を自動で行う方法」を解説しました。

実際サイズの変更や配置は短時間で済む業務ですが、回数が増えるとそれなりに時間を取られます。

今回紹介したコードを参考に実務に応用してください！

この記事で少しでも皆さんのお役に立てれば幸いです！

忘れないうちにお気に入り登録もお願いします！

ありがとうございました！