画像を貼り付けるとき、セルに合わせてサイズ調整するのを手作業でやるのは面倒なのでその方法。
罫線を書いているときなど、セルぴったりにしてしまうと罫線よりも画像が上に描写されてしまうので、マージン有無の設定もできるように。
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 件のコメント:
コメントを投稿