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