ここから本文です

特定のマスでダブルクリックをしたら画像をリサイズしてセル中央に貼り付ける。の...

j_s********さん

2019/8/2212:00:58

特定のマスでダブルクリックをしたら画像をリサイズしてセル中央に貼り付ける。のマクロを改造しているのですが、全てのシートで実行できるように変更したのですが、「オブジェクトが必要です」とでました。どう変更

すればよいか教えてください。
下記内容が元の特定のシートのみの場合でエラーはありませんでした。
Sub~Boolean)を
「Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)」に変更したら各シートで画像選択画面にまでは行くのですが、画像を選択したら上記エラーが表示されます。
ご指導!お願いします


Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

Dim pointList As Variant
pointList = Array("$A$7:$F$24", "$A$29:$F$46")

Dim point As Variant
Dim isPaste As Boolean
isPaste = False
For Each point In pointList
If Target.Address = point Then
isPaste = True
Exit For
End If
Next point

If isPaste Then
Cancel = True
Else
Exit Sub
End If

Dim strFilter As String
Dim myHH2 As Double
Dim Filenames As Variant
Dim mySP As Shape
strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="画像の選択", _
MultiSelect:=True)
If Not IsArray(Filenames) Then
Exit Sub
End If


For i = LBound(pointList) To UBound(pointList)
If pointList(i) = Target.Address Then Exit For
Next i
s = i


Application.ScreenUpdating = False

For j = LBound(Filenames) To UBound(Filenames)


If i > UBound(pointList) Then
Exit For
End If


Range(pointList(i)).Activate


Set mySP = Shapes.AddPicture( _
Filename:=Filenames(j), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=ActiveCell.Left, _
Top:=ActiveCell.Top + (ActiveCell.Height - Height) / 2, _
Width:=0, _
Height:=0)

With mySP
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
.LockAspectRatio = msoTrue ' 縦横比維持
.Height = ActiveCell.MergeArea.Height
.Width = ActiveCell.MergeArea.Width
myHH2 = (Target.Height / 2) - (mySP.Height / 2)
mySP.Top = Target.Top + myHH2

End With

Set mySP = Nothing

i = i + 1

Next j

Application.ScreenUpdating = True

End Sub

閲覧数:
66
回答数:
1

違反報告

ベストアンサーに選ばれた回答

mus********さん

2019/8/2512:05:05

下記のRangeオブジェクトやShapesオブジェクトには
シートオブジェクトからの呼び出しが必要です。
(シートオブジェクトに記述しているときには省略できますが、
ワークブックオブジェクトに記述するときには、引数に追加される
シート(sh)から呼び出します。)

>Range(pointList(i)).Activate
>Set mySP = Shapes.AddPicture( _

sh.Range(pointList(i)).Activate
Set mySP = sh.Shapes.AddPicture( _

ステップ実行すれば、エラーがどの行で発生しているかは
特定できるはずです。

質問した人からのコメント

2019/8/26 10:47:36

おー!なるほど!!
ご指導、ありがとうございます。
やってみます。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる