| |
▼wen さん：
こういう方法も（一応）あります。
そのPictures.Insert方式のままで、Excelのバージョンが2010だったら
いちど「図として切り取り」図の貼り付けをしてやれば、リンクしない
通常の画像になります。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim PicFile As Variant
Dim rX As Double, rY As Double
Dim ratio As Double, L As Double, T 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
ratio = rY
Else
ratio = rX
End If
.Width = .Width * ratio
.Height = .Height * ratio
'セルの中央（横方向/縦方向の中央）に配置
L = Target.Left + (Target.Width - .Width) / 2
T = Target.Top + (Target.Height - .Height) / 2
Dim is2010 As Boolean
is2010 = Val(Application.Version) > 13
is2010 = True
If is2010 Then 'ver14 = XL2010
.CopyPicture 'クリップボードに画像コピー
.Delete 'いったん削除
Else
.Left = L
.Top = T
End If
End With
If is2010 Then
Target.Activate
ActiveSheet.Paste
With Selection
.Left = L
.Top = T
End With
End If
Application.ScreenUpdating = True
Cancel = True
End Sub
参考まで。
|
|
kanabun
- 13/2/16(土) 9:12 -
