マクロが、うまくいかなくなった。

質問

Ａ：3に出勤数が表示されます。
出勤がある場合ｄ：3にハイパーリンクがあるので、リンク先の2ページめを印刷同じ
作業を下の段にのも繰り返す。
うまく動いていたのですが、新しくＰＣに移した当たりから　動かなくなりました。
厳密には　二人まではプリントするのですが、下の段までいかないみたいです。？

この様なメッセージが　↓

実行エラー9 インデックスが有効範囲にありません

下のマクロの　どの部分を書き換えれば動きますか？

Sub 請求明細自動印刷()
Application.ScreenUpdating = False
Dim I As Integer
Dim リンクシート As String

For I = 3 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(I, "A") <> 0 Then
リンクシート = Cells(I, "D").Hyperlinks(1).SubAddress
リンクシート = Left(リンクシート, InStr(リンクシート, "!") - 1)
Sheets(リンクシート).PrintOut From:=2, To:=2

End If
Next I
End Sub

回答No.2

cj_mover

＃１ｃｊです。補足欄拝見しました。

> 直接　マクロの表示・実行　とすれば書き換えなくても動くのです。
> ボタンは　図形を挿入してマクロの登録。　で、問題ないのですよね！

そこら辺が原因ということでしたらば、試しにボタンを替えてみる方が、
解決が早い場合もあります。
　『ワークシートにボタンを追加してマクロを割り当てる』
　http://office.microsoft.com/ja-jp/excel-help/HP010342137.aspx
　『Excel 2010 VBA の基礎知識』～「開発タブを表示するには」
　http://msdn.microsoft.com/ja-jp/library/ee814737.aspx
差し当たり、ActiveX コントロール コマンド ボタンを試してみてください。
リンクを張った一つ目のページで
「コマンド ボタンを追加する (ActiveX コントロール)」
の手順を一通り実行して、手順[９]を参考に[プロパティ] ボックスを表示し、
TakeFocusOnClick プロパティを False に設定してみてください。
手順[４-５]では、独自の VBA コードを入力します。
表示されたシートモジュールのコードペインの記述が、
以下のようになるよう書換えます。

Private Sub CommandButton1_Click()
' ' /// 請求明細自動印刷
Dim i As Integer
Dim リンクシート As String
　　Application.ScreenUpdating = False
　　For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
　　　　If Cells(i, "A") <> 0 Then
　　　　　　リンクシート = Cells(i, "D").Hyperlinks(1).SubAddress
　　　　　　リンクシート = Left(リンクシート, InStr(リンクシート, "!") - 1)
　　　　　　If InStr(リンクシート, "'") Then リンクシート = Replace(リンクシート, "'", "")
　　　　　　Sheets(リンクシート).PrintOut From:=2, To:=2
　　　　　　' ' ★
　　　　End If
　　Next i
End Sub

以上の方法で解決しない場合は、一旦、フォームコントロールを試してみてください。
その場合は、元の質問でご提示のコードに一行加筆したもの、に替え、
「ボタンを追加する (フォーム コントロール)」の手順を実行してください。
コードを整理すると以下のようになります。

Sub 請求明細自動印刷()　　'　　 8740694
Dim i As Integer
Dim リンクシート As String
　　Application.ScreenUpdating = False
　　For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
　　　　If Cells(i, "A") <> 0 Then
　　　　　　リンクシート = Cells(i, "D").Hyperlinks(1).SubAddress
　　　　　　リンクシート = Left(リンクシート, InStr(リンクシート, "!") - 1)
　　　　　　If InStr(リンクシート, "'") Then リンクシート = Replace(リンクシート, "'", "")
　　　　　　Sheets(リンクシート).PrintOut From:=2, To:=2
　　　　　　' ' ★
　　　　End If
　　Next i
End Sub

いずれの場合でもエラーが再現されてしまう場合は、
プリンターの処理によって占有されている制御を
取り戻す為の何らかの処理が必要になります。
こちらではこの手のエラー状況を再現できている訳ではないので、
ピンポイントで当てることは出来ませんけれど、厚めに対策してみると、
' ' ★マークの位置に以下の記述を挿入して試してみてください。
　　　　　　DoEvents:　　DoEvents
　　　　　　Application.Wait DateAdd("s", 1, Now)
　　　　　　AppActivate (Application.Caption)
　　　　　　ActiveSheet.Activate
　　　　　　ActiveCell.Activate
　　　　　　DoEvents
のような対策の内、すべて必要ではないけれど、幾つかを組み合わせることで、
エラー回避に役立つかも知れません（他にもありますが取り敢えず）。

尚、因みに、
> 実行エラー9 インデックスが有効範囲にありません

> ボタンから動かしたときの　エラー箇所は（黄色く反転）
> リンクシート = Cells(I, "D").Hyperlinks(1).SubAddress
> です。この箇所に原因がありますか！

例えば、何らかの原因で実行の途中にアクティブシートが変更されていたりすると、
アクティブなシート（別のシート）ではCells(I, "D")に.Hyperlinksが設定されていない、
なんて場合にも同様のエラーに掛かることになります。
この場合の原因としては、
・実行するマクロに（実は他にも記述があって）他シートを選択する記述がある場合。
（ActiveX コントロール コマンド ボタンを上記の手順で使用する場合はこの原因を回避できます。）
・印刷対象ブックのThisWorkbookモジュールにてPrivate Sub Workbook_BeforePrint()
が設定されていて、そちらでの処理が関与している場合。
等も考えられますので、アクティブシートが変更されないように（変更されたりしてないか）、
一応、確認しておいた方が良いと思います。

＃１で指摘した原因は今回のトラブルには直接関わっていないようですが、
そもそも必要な手当てであることには変わりありませんので、そのまま追記しておいてください。

うまく解決できるといいのですが、、、。

回答No.1

cj_mover

こんにちは。

リンクシート = Cells(I, "D").Hyperlinks(1).SubAddress
リンクシート = Left(リンクシート, InStr(リンクシート, "!") - 1)
に続けて一行追加、
If InStr(リンクシート, "'") Then リンクシート = Replace(リンクシート, "'", "")

のようにしてみてたら、どうでしょう？
これは、例えば、
"Sheet1 (2)"というような通常規格外（この場合は半角スペース使用）のシート名を参照する際、
hyperlink.SubAddress のシート参照が、"'Sheet1 (2)'!C3:Q202" のように、
' シングルクォートで挟まれることへの手当てで、
Excel一般機能に設定されたシート参照文字列をVBAで利用する場合には必要な処理です。
以上の前提でテストすると確かに同様のエラーが再現できます。
また、既存のシートのコピーを作成し自動で付与されたシート名を使用する、
といったように、気が付き難い状況の変化が原因ですから、
ひとつの有力な解決策として考えられます。

もし、上記の対処で解決に至らない場合は、PC環境の変化に気を取られることなく、
他の点で何か手を加えたこと、を一通り思い返して、原因を特定していくようにしてください。
詳細な補足があれば、再度レスします。

以上です。

お礼

お礼が遅くなりました。
ありがとうございます。
よろしければ　今後ともご指導お願いいたします。

補足

ご回答ありがとうございます。
教えてもらったように張り付けましたら　動いたのでホッとしてたのですが、二回目以降同じ症状が続くので、
色々試しましたら、どうも　ボタンから実行すると動かなくて
直接　マクロの表示・実行　とすれば書き換えなくても動くのです。素人でうまく説明できませんが、ボタンは　図形を挿入してマクロの登録。　で、問題ないのですよね！
いぜんは、動いたのですが・・・
ボタンから動かしたときの　エラー箇所は（黄色く反転）
リンクシート = Cells(I, "D").Hyperlinks(1).SubAddress
です。この箇所に原因がありますか！