Excel VBA インデックスの境界について

メッセージボックスに文字を入力するとそれに該当するシェイプが表示されるようなＶＢＡを組んでいるのですが、“指定したコレクションに対するインデックスが境界を超えています”と出ます。おそらく上限があると思うのですが、それを回避する方法を教えてください。

No.3 回答者： papayuka 回答日時： 2005/12/03 13:43

> もし、そうだとしたら上記のＶＢＡをどのように分ければよいでしょうか？

　 ActiveCell.Activate
　 MsgBox "表示を終了してよろしいですか", vbOKOnly + vbInformation, "表示"

この2行を消して

　.Shapes.Range(sh).Line.Visible = msoFalse

を別の Sub にするだけだと思います。

> Shape38,39,40になると、また「インデックスが境界を超えています」と出ました・・・

こちらの環境（Excel2000）ではShapes200でも動作します。
オートシェイプのインデックスはオートフィルタの▼や入力規則リストの▼でも増えるのですが、実際にインデックスが超えていなければエラーは出ませんでした。
実際のファイルやシートの状態を見えれば良いのですが、、、

やりたい事が今ひとつ掴めないのですが、もっと違うアプローチで同様の事が実現出来ないか模索した方が良いかも知れません。

No.2 回答者： papayuka 回答日時： 2005/12/02 01:11

Test1を実行するとどんな数字が表示されますか？

これが16未満なら ActiveSheet.Shapes(16).Select は「インデックスが境界を超えています」って事です。

Sub Test1()
　　MsgBox ActiveSheet.Shapes.Count
End Sub

下記は参考に

Sub Test2()
Dim sh(), s As String
With ActiveSheet
　s = .Range("C117").Text
　Select Case s
　Case "Ａ"
　　　sh = Array(.Shapes(14).Name, .Shapes(15).Name)
　Case "Ｂ"
　　　sh = Array(.Shapes(2).Name, .Shapes(3).Name, .Shapes(4).Name)
　Case "Ｄ"
　　　sh = Array(.Shapes(8).Name, .Shapes(9).Name, .Shapes(10).Name)
　Case Else
　　MsgBox "指定した地点 " & s & " はありません", _
　　　　　　　　　　 vbOKOnly + vbExclamation, "指定範囲外"
　　Exit Sub
　End Select
　.Shapes.Range(sh).Line.ForeColor.SchemeColor = 10
　.Shapes.Range(sh).Line.Visible = msoTrue
　 ActiveCell.Activate
　 MsgBox "表示を終了してよろしいですか", vbOKOnly + vbInformation, "表示"
　.Shapes.Range(sh).Line.Visible = msoFalse
End With
End Sub

この回答への補足

ありがとうございます。
test1を実行すると「25」と表示されます。

test2は私が組んでいるものを違う形で表示してくれたのですね。
かなり感動しています。
本当にありがとうございます。
あつかましいようですが、もうひとつお聞きしたいのですが・・・
マクロを実行した際に今のないようですとメッセージボックスに
「表示を終了してもよろしいですか？」と言う表示が出て、シートを動かす（上下や左右）ことが
できなくなりますが、それを動かせるようにすることはかのですか？
このShapeを表示させるＶＢＡと終了させるＶＢＡを
別々に組み、それぞれのＶＢＡが実行できるようなボタンを作るほうが賢明なのでしょうか？
もし、そうだとしたら上記のＶＢＡをどのように分ければよいでしょうか？

補足日時：2005/12/03 01:37

この回答へのお礼

スミマセン。補足ですが・・・
Shape38,39,40になると、また「インデックスが境界を超えています」と出ました・・・

お礼日時：2005/12/03 01:45

No.1 回答者： papayuka 回答日時： 2005/11/18 21:59

本当に上限の問題でしょうか？

該当部分のソースコードを載せた方がアドバイスが得られやすいと思いますよ。

例えば、シートにオートシェイプを１～２個おいて下記を実行すると同じエラーが出ます。

Sub Test()
　cnt = ActiveSheet.Shapes.Count
　MsgBox "シェイプが " & cnt & "個しかないのに" & vbCrLf & _
　　　　　cnt + 1 & "個目を選択しようとしてるとか、、"
　ActiveSheet.Shapes(cnt + 1).Select
End Sub

この回答への補足

返答が遅くなってしまい、スミマセン。
現在、下記のようなＶＢＡを組んでいてエラーがでます。

Sub iro()
Dim i As String
i = Range("c117").Value
If i = "Ａ" Then
ActiveSheet.Shapes(16).Select
ActiveSheet.Shapes(15).Select
ActiveSheet.Shapes(14).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(16).Select
ActiveSheet.Shapes(15).Select
ActiveSheet.Shapes(14).Select Replace:=False
modosu

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

ElseIf i = "Ｄ" Then
ActiveSheet.Shapes(8).Select
ActiveSheet.Shapes(9).Select Replace:=False
ActiveSheet.Shapes(10).Select Replace:=False
hyoji
MsgBox "表示を終了してよろしいですか", vbOKOnly
ActiveSheet.Shapes(8).Select
ActiveSheet.Shapes(9).Select Replace:=False
ActiveSheet.Shapes(10).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

いかがでしょうか？

補足日時：2005/12/02 00:01