解決済み

Excelで画像の切り替え

  • 暇なときにでも
  • 質問No.905412
  • 閲覧数1950
  • ありがとう数3
  • 気になる数0
  • 回答数2
  • コメント数0

お礼率 67% (58/86)

Seet1のA1セルに"自動車"、A2セルに"バイク"と入力し、Seet2にその自動車、バイクの画像(クリップアート)があるとします。
そこで、Seet1のA1をクリックした時に、同じSeet1にSeet2の自動車の画像を表示させ、A2をクリックした時にはA1の画像は消え、A2のバイク画像を表示して切り替えたいのですができるのでしょうか。

質問者が選んだベストアンサー

  • 回答No.2

ベストアンサー率 62% (292/464)

次の手順で操作すると、ご希望通り機能すると思います。

Sheet2 の自動車の画像を選択して「名前ボックス」を「自動車」に上書きします。
(現在は、「図 1」などになっていると思います。)
同様に「バイク」の画像にもその名前を付けます。
画像は、自由に増やしてもOKです。

・Sheet1のシート名タブを右クリックして「コードの表示」を指定し、
 開いたコードウィンドウに下記コードをコピーして貼り付けます。
・コードの3~4行目を実情に合わせ、図の名称を指定する範囲(絵の数)と表示するセル位置を
 設定変更します。
・Alt+ Q (または、右上隅の×)でウィンドウを閉じ、シートに戻ります。
・メニューから[ツール]-->[マクロ]-->[セキュリティ]で「セキュリティレベル」を
 「中」にして[OK]します。
・以上で設定完了です。

これで、指定したセル範囲内に画像の「名前」を入力してみてください。
こんな感じで如何でしょうか。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Sp As Picture
Const PicTypeCell = "A1:A5" ' < ---図の名称を指定する範囲
Const PicDispCell = "C5" '  < ---図を表示する位置(左上セル)
If Target.Count > 1 Then Exit Sub
On Error GoTo NothingPic
Application.EnableEvents = False
If Not Intersect(Range(PicTypeCell), Target) Is Nothing Then
  For Each Sp In ActiveSheet.Pictures
    If Sp.TopLeftCell.Address(False, False) = _
      PicDispCell Then Sp.Delete
  Next Sp
  Sheet2.Shapes(Target.Value).Copy
  Range(PicDispCell).Activate
  ActiveSheet.Paste
End If
NothingPic:
Target.Activate
Application.EnableEvents = True
End Sub
 

その他の回答 (全1件)

  • 回答No.1

ベストアンサー率 58% (518/881)

VBA での処理になると思います。
自動記録と寄せ集めですが、こんなのはいかがでしょうか。
Sheet1 の A1、A2 にはご質問の例題のように入力されていて、
Sheet2 の画像それぞれには名前ボックスを使って、Sheet1 の
A1、A2 と同じ名前がつけられているとします。

Sheet1 タブの右クリックから「コードの表示」を選択し、表示
される画面に下記モジュールをコピペします。
実行は、シングルクリックではなくダブルクリックです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim DT As Variant, TGT As String
Application.ScreenUpdating = False
If Target.Row > 2 Or Target.Column > 1 Then Exit Sub
Range("A1:A2").Select
DT = Selection
TGT = Target.Value
ActiveSheet.Shapes.SelectAll
Selection.Delete
Sheets("Sheet2").Select
ActiveSheet.Shapes(TGT).Select
Selection.Copy
Sheets("Sheet1").Select
Range("C7").Select
ActiveSheet.Paste
Range("A1:A2") = DT
Application.ScreenUpdating = True
End Sub
結果を報告する
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。
関連するQ&A
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,600万件のQ&Aを分析して最適な回答をご提案します。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

ピックアップ

ページ先頭へ