EXCEL VBA これであっていますか？

質問

エクセルに地図を貼り付け、その中のある地点Aから半径１キロ、２キロ、３キロといった具合に円を描いています。ある地点B、Cも同様に円があります。セルに“A”
と入力した際に該当する地点の円（１キロ、２キロ、３キロの3種類）を赤く表示し、終了すると円が消える（線なしに変わる）ようにするために以下のようなＶＢＡを組みました。が、円が２つしか赤くならなかったり、
ばあいによっては「インデックスが境界を超えています」とエラーが出たりします。
どうしたら良いか教えてください。

Sub iro()
Dim i As Variant
i = InputBox("表示する地点を指定してください", "地点指定")
If i = "A" Then
ActiveSheet.Shapes(1).Select
ActiveSheet.Shapes(2).Select
ActiveSheet.Shapes(3).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(1).Select
ActiveSheet.Shapes(2).Select
ActiveSheet.Shapes(3).Select Replace:=False
modosu

ElseIf i = "B" Then
ActiveSheet.Shapes(4).Select
ActiveSheet.Shapes(5).Select
ActiveSheet.Shapes(6).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(4).Select
ActiveSheet.Shapes(5).Select
ActiveSheet.Shapes(6).Select Replace:=False
Else
MsgBox "指定した地点がありません", vbOKOnly
End If

End Sub
Sub hyoji()
Selection.ShapeRange.Line.Visible = msoTrue
'「線なし」に設定されている場合、線を表示
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Range("A1").Select
End Sub

Sub modosu()
Selection.ShapeRange.Line.Visible = msoFalse
'「線なし」に設定
Range("A1").Select
End Sub

回答No.1

finneganswake · ベストアンサー

直観して直してみたけど。
Replaceが足りないんだよ。
それとBのmodosuを入れておきました。
index云々ってのは出なかったのでわからないけど。

Sub iro()
Dim i As Variant
i = InputBox("表示する地点を指定してください", "地点指定")
If i = "A" Then
ActiveSheet.Shapes(1).Select Replace:=False
ActiveSheet.Shapes(2).Select Replace:=False
ActiveSheet.Shapes(3).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(1).Select Replace:=False
ActiveSheet.Shapes(2).Select Replace:=False
ActiveSheet.Shapes(3).Select Replace:=False
modosu

ElseIf i = "B" Then
ActiveSheet.Shapes(4).Select Replace:=False
ActiveSheet.Shapes(5).Select Replace:=False
ActiveSheet.Shapes(6).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(4).Select Replace:=False
ActiveSheet.Shapes(5).Select Replace:=False
ActiveSheet.Shapes(6).Select Replace:=False
modosu

Else
MsgBox "指定した地点がありません", vbOKOnly
End If

End Sub
Sub hyoji()
Selection.ShapeRange.Line.Visible = msoTrue
'「線なし」に設定されている場合、線を表示
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Range("A1").Select
End Sub

Sub modosu()
Selection.ShapeRange.Line.Visible = msoFalse
'「線なし」に設定
Range("A1").Select
End Sub

回答No.3

ja7awu

何か、いちいち Shape を Selectしているようですが、これでは Shapeの輪郭が表示されて
体裁が良くないのではありませんか?

たぶん、こんな感じの方のようにしたいのでは・・・?

Sub iro()
Dim i As String
Dim N As Integer
Dim Start As Integer
i = InputBox("表示する地点を指定してください", "地点指定")
If StrConv(i, vbUpperCase) = "A" Then
　　Start = 1
ElseIf StrConv(i, vbUpperCase) = "B" Then
　　Start = 4
ElseIf i = "" Then
　　MsgBox "キャンセルされました。"
　　Exit Sub
Else
　　MsgBox "指定した地点がありません", vbCritical
　　Exit Sub
End If
For N = Start To Start + 2
　　With ActiveSheet.Shapes(N).Line
　　　　.ForeColor.SchemeColor = 10
　　　　.Visible = msoTrue
　　End With
Next N
MsgBox "表示を終了してよろしいですか"
For N = Start To Start + 2
　　ActiveSheet.Shapes(N).Line.Visible = msoFalse
Next N
Range("A1").Activate
End Sub

回答No.2

meron_

回答がない場合、↓こちらをお奨めします。
http://park7.wakwak.com/~efc21/cgi-bin/wwwlng.cgi

ただし、この質問を終了した（締め切った）後に
他のサイトで質問して下さい。（マルチポスト禁止）