| |
ThisWorkbookモジュールに、以下のコードを入れて定数 Fol の値を変更する。
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
Dim Lp As Single, Tp As Single
Dim Wp As Single, Hp As Single
Dim Pic As Object
Dim MyF As String
Const Fol As String = _
"C:\Documents and Settings\User\My Documents\My Pictures"
'↑実際に画像ファイルを保存しているフォルダーのパスに変更
With ActiveCell
If .MergeCells = False Then Exit Sub
With .MergeArea
Lp = .Left + 0.5: Tp = .Top + 0.5
Wp = .Width - 1: Hp = .Height - 1
End With
End With
ChDir
With Application
MyF = .GetOpenFilename("画像ファイル(*.bmp),*.bmp")
If MyF = "False" Then GoTo ELine
.ScreenUpdating = False
End With
Cancel = True
With Sh.Pictures.Insert(MyF)
.Left = Lp: .Top = Tp
.Width = Wp: .Height = Hp
.OnAction = "Del_Pic"
End With
ELine:
If Sh.ProtectDrawingObjects = False Then
Sh.Protect , True, False, False
End If
With Application
ChDir .DefaultFilePath
.ScreenUpdating = True
End With
End Sub
標準モジュールに以下のマクロを入れる。
Sub Del_Pic()
Dim x As Variant
x = Application.Caller
If VarType(x) <> 8 Then Exit Sub
If MsgBox("この画像を削除しますか ?", vbYesNo) = vbYes Then
With ActiveSheet
.Unprotect
.Pictures(x).Delete
.Protect , True, False, False
End With
End If
End Sub
そして任意の結合セルをダブルクリックすると、画像ファイルの保存先をカレント
フォルダーとして、ファイルを開くダイアログが出ます。そこから任意のファイル
を選んで OK するだけです。
挿入した画像は、シングルクリックすると削除を問い合わせるメッセージが出ます。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
