2019年3月5日火曜日

VBA; 005 画像をセルのサイズに合わせて貼り付ける

自分用メモ。
画像を貼り付けるとき、セルに合わせてサイズ調整するのを手作業でやるのは面倒なのでその方法。
罫線を書いているときなど、セルぴったりにしてしまうと罫線よりも画像が上に描写されてしまうので、マージン有無の設定もできるように。

Private Sub pasteImageFromFile(targetRange As Range, imageFilePath As String, margin As Integer, isLink As Boolean)
    Dim image As Shape
    Dim zoom_scale As Double
    Dim margin_point As Double
    Dim ht As Integer
    Dim wd As Integer
    Dim isSave As Boolean
    
    margin_point = (margin * (72 / 25.4)) * 2
    
    If isLink = False Then
        isSave = True
    Else
        isSave = False
    End If

    Set image = targetRange.Worksheet.Shapes.AddPicture( _
        Filename:=imageFilePath, _
        LinkToFile:=isLink, _
        SaveWithDocument:=isSave, _
        Left:=targetRange.Left, Top:=targetRange.Top, _
        Width:=-1, Height:=-1)
    
    With image
        .LockAspectRatio = msoTrue
        ht = targetRange.Height - margin_point
        wd = targetRange.Width - margin_point
        If wd / .Width < ht / .Height Then
            zoom_scale = Application.WorksheetFunction.RoundDown(wd / .Width, 2)
        Else
            zoom_scale = Application.WorksheetFunction.RoundDown(ht / .Height, 2)
        End If
        
        .ScaleWidth zoom_scale, msoFalse, msoScaleFromTopLeft
        
        .Left = .Left + (targetRange.Width - .Width) / 2
        .Top = .Top + (targetRange.Height - .Height) / 2
    End With

End Sub

引数としては貼り付け先のrangeオブジェクト、イメージのファイルパス、マージン(mm)、リンクにするか貼り付けるか。
リンクにすると、ファイルにはリンク先の情報が保存されるので、ファイルサイズは小さくなるけど画像データを毎回読み込む必要あり。なのでexcelファイルだけでは配布できなくなる。
マージン(というより画像サイズ)は本来ポイント単位での指定だけど、いちいちmmに換算してられないので引数をmmで設定。上下左右のマージンなので、引数を2倍にして使う。
LockAspectRatioで縦横比を固定。
対象レンジの幅・高さとイメージのサイズから倍率を決定。このとき、縦横のどちらが大きいかを見て調整。最後にイメージの配置場所を、セルの中心に移動。

もともとどこかのサイトのコードを参考(というかほぼコピペ)で書いたんだけど、どこだったか探しても見つからなかったのでリンクが張れない。残念。

0 件のコメント:

コメントを投稿