ここから本文です

エクセルVBA 特定のセルでなければ、コードを実行しない。 シートの特定のセル...

ha5********さん

2018/1/317:53:01

エクセルVBA 特定のセルでなければ、コードを実行しない。

シートの特定のセルでなければ、起動しないコードを組んだのですが うまく動作しません。

Worksheet_SelectionChange とか Change イベントに組み込めばうまくいくのかのもしれませんが、
コマンドボタンで起動したいので ちょっと。

要は指定のセルに画像を貼り付けたく 他のセルではスルーしたい

以下コード 色々試行錯誤したのですが、自己解決は難しいです。

Private Sub CommandButton4_Click()
Dim objFileName As String
Dim objShape As Shape
Dim Target As Range

Set Target = Range("K6,K26,U6,U26,AE6,AE26,AO6,AO26,AY6,AY26") _
'これを追加したらエラーは出なくなったが、全部のシートに反応する。
If Intersect(Target, Range("K6,K26,U6,U26,AE6,AE26,AO6,AO26,AY6,AY26")) Is Nothing Then Exit Sub
objFileName = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "画像選択ダイアログ")

If objFileName = "" Then Exit Sub
If VarType(objFileName) = vbBoolean = False Then Exit Sub

' On Error Resume Next

Set objShape = ActiveSheet.Shapes.AddPicture(Filename:=objFileName, LinkToFile:=False, SaveWithDocument:=True, _
Left:=Selection.Left + 3, Top:=Selection.Top, Width:=480, Height:=320)

End Sub


よろしくお願いします。

閲覧数:
55
回答数:
3
お礼:
100枚

違反報告

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

プロフィール画像

カテゴリマスター

kky********さん

2018/1/318:36:27

Worksheet_SelectionChange や Changeイベントでなくコマンドボタンで起動したいのなら、セルを選択してからマクロ実行なのでしょうから。

Private Sub CommandButton4_Click()
Dim objFileName As String
Dim objShape As Shape
Dim Target As Range
Set Target = Range("K6,K26,U6,U26,AE6,AE26,AO6,AO26,AY6,AY26")
If Intersect(Selection, Target) Is Nothing Then Exit Sub
objFileName = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "画像選択ダイアログ")
If objFileName = "False" Then Exit Sub
Set objShape = ActiveSheet.Shapes.AddPicture(Filename:=objFileName, LinkToFile:=False, SaveWithDocument:=True, _
Left:=Selection.Left + 3, Top:=Selection.Top, Width:=480, Height:=320)
End Sub

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

2018/1/3 21:09:26

早速の回答ありがとうございました
両者ともベストアンサーに選びたいのですが、あいにく1人
If Intersect(Selection, Target) Is Nothing Then Exit Sub
上記の部分の書き方が、わからなかったので、いくら自分で考えたり検索してもだめでした。
ご指摘の通りセルを選択してからのボタン操作です

無事目的通りの動作になりました。
ありがとうございました

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

プロフィール画像

カテゴリマスター

taihenda****さん

2018/1/318:42:47

Private Sub CommandButton4_Click()
Dim objFileName As String
Dim objShape As Shape
Dim Target As Range

Set Target = Range("K6,K26,U6,U26,AE6,AE26,AO6,AO26,AY6,AY26")
If Intersect(Target, Selection) Is Nothing Then Exit Sub
objFileName = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "画像選択ダイアログ")

MsgBox VarType(objFileName) 'test・・8は文字列11にならない??
MsgBox objFileName 'test・・Falseが返る??
If objFileName = False Then Exit Sub

Set objShape = ActiveSheet.Shapes.AddPicture(Filename:=objFileName, LinkToFile:=False, SaveWithDocument:=True, _
Left:=Selection.Left + 3, Top:=Selection.Top, Width:=480, Height:=320)

End Sub


キャンセルしたときの処理が解説サイトとちょっと違うのでわからないことがありますがバージョンと関係あるのかも?

con********さん

2018/1/318:11:13

IntersectはApplicationオブジェクトのメソッドなので、

Application.Intersect と修飾してやる必要があるのではないですか?

原因がこれかどうかはわかりませんが…

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

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

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

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

閉じる

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

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

閉じる