|
こんにちは
結局、ブックのファイルサイズの圧縮の事のようなので、βさんのコードのように
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim myPic As Variant
Dim myRange As Range
Dim rX As Single
Dim rY As Single
Dim cht As Chart
'挿入のセルを指定
If Application.Intersect(Target, Range("D6,D23,D40")) Is Nothing Then Exit Sub
Cancel = True
'写真挿入
myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")
If myPic = False Then
Application.ScreenUpdating = True
MsgBox "画像を選択してください"
Exit Sub
End If
Application.ScreenUpdating = False
Set myRange = Target 'このセル範囲に収まるように画像を縮小する
With ActiveSheet.Pictures.Insert(myPic)
.ShapeRange.LockAspectRatio = msoTrue
.Width = myRange.Width
If .Height > myRange.Height Then .Height = myRange.Height
.Left = myRange.Left + myRange.Width / 2 - .Width / 2
.Top = myRange.Top + myRange.Height / 2 - .Height / 2
End With
Application.ScreenUpdating = True
Cancel = True
End Sub
とすれば良いと思います。
|
|