EXCELに画像を貼り付ける事多いですね。
セルの大きさに自動調整して画像挿入する方法を紹介します。
セルの大きさに自動調整して画像を挿入する
まずは結果をご覧ください。
全て同じ画像を異なるサイズのセルに挿入した結果です。
やりたかった事は
１．画像を挿入したいセルをダブルクリック
２．画像ファイルを選択
３．セルのサイズに自動調整した画像が挿入される
です。
VBAを紹介
VBAの始め方
VBAをやった事がない方はこちらをご覧ください。
【EXCELで仕事の効率化】EXCEL VBAの始め方＆保存方法
始め方から保存方法まで紹介しています。
VBA紹介
こちらのVBAは
ThisWorkbook
に記載して下さい。
こちらをコピー＆ペーストして下さい。
楽ちんです♪
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はこちらを参考にさせて頂きました。
実行してみる
実行方法は画像を挿入したいセルをダブルクリック。
画像を選択するウィンドウが開きます。
ファイルを選択して「開く」するだけです。
いろんなサイズのセルに画像挿入した結果です。
結合したセルにも対応しています。
まとめ
報告書など作成する時などにおすすめです。
画像挿入後にセルサイズ変更した場合は追従しません。
画像を一旦削除して再度挿入してください。
当ブログのトップページはこちらです。
ブックマークして頂けると嬉しいです。
よろしくお願いいたします。
コメント