【VBA】画像ファイルをセル範囲に合わせて拡大縮小するマクロ

2021年6月19日

あ~画像サイズ調整するのクソだるい~
誰か代わりにやってくれー!

カチカチカチカチカチカチカチ…

資料作る時とかに画像のサイズ調整するのって面倒ですよね。

そんなあなたに朗報です
画像サイズを一発で変更するマクロを紹介します

画像サイズはExcelのセル範囲に合わせて、自動で拡大縮小するのでカチカチする必要はありません!

このマクロを使って不毛な作業から解放されちゃいましょう!

画像ファイルをセル範囲に合わせて拡大縮小するマクロ

どんなことができるのか?

まず貼付けしたい範囲を選択して、マクロを実行します。

ファイル選択ダイアログが開くので、画像ファイルを選択します。

すると、画像ファイルが選択した範囲に合わせたサイズで貼付けされます。
※貼付けされるのは選択範囲のど真ん中で、余白調整も可能です。

ソースコード

Sub ImportPicSelection()
'外部から画像ファイルをインポートし、選択範囲のサイズに合わせて貼付ける

    Const MARGIN = 0.95 '余白調整用
    
    'セル以外を選択している場合はExit
    If Not TypeName(Selection) = "Range" Then Exit Sub
    
    '画像ファイルの選択
    Dim filePath As String
    filePath = Application.GetOpenFilename( _
        filefilter:="Pictures (*.png; *.gif; *.jpg; *.bmp; *.tif),*.png; *.gif; *.jpg; *.bmp; *.tif", _
        Title:="画像選択ダイアログ", _
        MultiSelect:=False)
    
    '画像選択されない場合はExit
    If filePath = "False" Then Exit Sub
    
    '画像ファイルの取込み
    With ActiveSheet.Shapes.AddPicture( _
        Filename:=filePath, _
        linktofile:=False, _
        savewithdocument:=True, _
        Left:=Selection.Left, _
        Top:=Selection.Top, _
        Width:=0, _
        Height:=0)
        
        '一旦元のサイズに戻す
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
        
        'サイズ調整(Selection内に収める)
        Dim dblScal As Double
        If Selection.Width / .Width < Selection.Height / .Height Then
            dblScal = WorksheetFunction.RoundDown(Selection.Width / .Width, 2) * MARGIN
        Else
            dblScal = WorksheetFunction.RoundDown(Selection.Height / .Height, 2) * MARGIN
        End If
        .ScaleHeight dblScal, msoFalse
        .ScaleWidth dblScal, msoFalse
        
        'Selectionの中心に配置
        .Left = .Left + (Selection.Width - .Width) / 2
        .Top = .Top + (Selection.Height - .Height) / 2
        
    End With
End Sub

AddPictureというメソッドで画像の取り込みをしています。
取り込んだ画像ファイルに対して、セル範囲に合わせて拡大(縮小)率を計算して選択範囲内に収めています。

そして、一番最後に選択範囲の中心に来るように移動させています。

余白はMARGINという定数を変更することで調整できるように作っています。
今は0.95としていますが、必要に応じて変更してみてください。

他の「VBAで図を操る」の記事はこちらからどうぞ