• ベストアンサー

Excelで画像の切り替え

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

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

  • ベストアンサー
  • ja7awu
  • ベストアンサー率62% (292/464)
回答No.2

次の手順で操作すると、ご希望通り機能すると思います。 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

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