ダブルクリックでセルに画像を貼りつける(Pictures.Insertメソッド)|Excel VBA |
[ファイルを開く]ダイアログボックスで指定した画像をセルに貼りつけます。
画像が縦長の場合は縦方向をセル高いっぱい、横方向をセルの中央に配置し、画像が横長の場合は縦方向をセルの中央、横方向をセル幅いっぱいに配置します。
セルをダブルクリックしたときに貼りつけるには、対象シートのシートモジュールにBeforeDoubleClickイベントのイベントプロシージャを記述します。ただし、このイベントプロシージャを記述したワークシートでのみ有効となります。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim PicFile As Variant
Dim rX As Double, rY As Double
'[ファイルを開く]ダイアログボックスを表示
PicFile = Application.GetOpenFilename( _
"画像ファイル,*.jpg;*.jpeg;*.gif;*.tif;*.png;*.bmp")
If VarType(PicFile) = vbBoolean Then Cancel = True: Exit Sub
Application.ScreenUpdating = False
'画像を挿入
With ActiveSheet.Pictures.Insert(PicFile)
rX = Target.Width / .Width
rY = Target.Height / .Height
If rX > rY Then
.Height = .Height * rY
Else
.Width = .Width * rX
End If
'セルの中央(横方向/縦方向の中央)に配置
.Left = Target.Left + (Target.Width - .Width) / 2
.Top = Target.Top + (Target.Height - .Height) / 2
End With
Application.ScreenUpdating = True
Cancel = True
End Sub