【EXCEL VBA】セルの大きさに自動調整して画像挿入する方法 - アラフィフ生産技術の日常

【EXCEL VBA】セルの大きさに自動調整して画像挿入する方法

【EXCEL VBA】セルの大きさに自動調整して画像挿入する方法 EXCEL
【EXCEL VBA】セルの大きさに自動調整して画像挿入する方法

EXCELに画像を貼り付ける事多いですね。
セルの大きさに自動調整して画像挿入する方法を紹介します。

セルの大きさに自動調整して画像を挿入する

まずは結果をご覧ください。

【EXCEL VBA】セルの大きさに自動調整して画像挿入する方法 結果
結果

全て同じ画像を異なるサイズのセルに挿入した結果です。
やりたかった事は
1.画像を挿入したいセルをダブルクリック
2.画像ファイルを選択
3.セルのサイズに自動調整した画像が挿入される
です。

VBAを紹介

VBAの始め方

VBAをやった事がない方はこちらをご覧ください。
【EXCELで仕事の効率化】EXCEL VBAの始め方&保存方法
始め方から保存方法まで紹介しています。

VBA紹介

こちらのVBAは
ThisWorkbook
に記載して下さい。

【EXCEL VBA】セルの大きさに自動調整して画像挿入する方法 VBA入力
VBA入力

こちらをコピー&ペーストして下さい。
楽ちんです♪

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim A As Variant
Dim ASS As Object
Dim I As String
Dim J As String
Cancel = True

A = Application.GetOpenFilename _
("画像ファイル,*.jpg;*.png", , "画像ファイルを選択して下さい", , False)

If A = False Then
    Exit Sub
End If

For Each ASS In ActiveSheet.Shapes
    I = ASS.TopLeftCell.MergeArea.Address
    J = Target.Address
    If I = J Then ASS.Delete
Next

Set ASS = ActiveSheet.Shapes.AddPicture(Filename:=A, LinkToFile:=False, _
SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _
Width:=0, Height:=0)
ASS.ScaleHeight 1, msoTrue
ASS.ScaleWidth 1, msoTrue
ASS.LockAspectRatio = msoTrue

If ASS.Height / Target.Height > ASS.Width / Target.Width Then
    ASS.Height = Target.Height
Else
    ASS.Width = Target.Width
End If

ASS.Left = Target.Left + (Target.Width - ASS.Width) / 2
ASS.Top = Target.Top + (Target.Height - ASS.Height) / 2

Set ASS = Nothing
End Sub


当VBAはこちらを参考にさせて頂きました。

実行してみる

実行方法は画像を挿入したいセルをダブルクリック。
画像を選択するウィンドウが開きます。

【EXCEL VBA】セルの大きさに自動調整して画像挿入する方法 画像選択ウィンドウ
画像選択ウィンドウ

ファイルを選択して「開く」するだけです。
いろんなサイズのセルに画像挿入した結果です。

【EXCEL VBA】セルの大きさに自動調整して画像挿入する方法 結果
結果

結合したセルにも対応しています。

【EXCEL VBA】セルの大きさに自動調整して画像挿入する方法 結合したセルでの結果
結合したセルでの結果

まとめ

報告書など作成する時などにおすすめです。
画像挿入後にセルサイズ変更した場合は追従しません。
画像を一旦削除して再度挿入してください。

当ブログのトップページはこちらです。
ブックマークして頂けると嬉しいです。
よろしくお願いいたします。

コメント

タイトルとURLをコピーしました