EXCEL VBAコミュのご享受下さい。「目次シート作成」

シートを非表示にしたら、ハイパーリンクで普通に飛べないので
あんまりハイパーリンクにする意味はないのですが、、、
ハイパーリンクのいい所は、
● 左クリックで動作すること
● Shape等ではないので不用意にシートが複雑にならないこと
ですね。
という訳で、ハイパーリンクでいきます。

ThisWorkbookモジュールに以下のコードを書いてください。

Const cMOKUJI As String = "目次"

Private Sub Workbook_Open()
　　Dim shtMOKUJI As Worksheet
　　Dim i As Worksheet
　　Dim wkRow As Long

　　Set shtMOKUJI = Me.Worksheets(cMOKUJI)
　　shtMOKUJI.Range("A:A").Clear
　　shtMOKUJI.Cells(1, "A").Value = "目次"
　　wkRow = 1
　　' Ａ列のセルにハイパーリンクを設定する
　　For Each i In Me.Worksheets
　　　　If Not i.Name = cMOKUJI Then
　　　　　　wkRow = wkRow + 1
　　　　　　shtMOKUJI.Hyperlinks.Add _
　　　　　　　　Anchor:=shtMOKUJI.Cells(wkRow, "A") _
　　　　　　 , Address:="" _
　　　　　　 , SubAddress:=i.Name & "!A1" _
　　　　　　 , TextToDisplay:=i.Name
　　　　End If
　　Next i
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　Dim i As Worksheet

　　' 目次シートを表示する
　　Me.Worksheets(cMOKUJI).Visible = xlSheetVisible
　　' 目次シート以外を非表示にする
　　For Each i In Me.Worksheets
　　　　If Not i.Name = cMOKUJI Then
　　　　　　i.Visible = xlSheetVeryHidden
　　　　End If
　　Next i
　　' 上書き保存する
　　Me.Save
End Sub

Private Sub Workbook_SheetFollowHyperlink _
　　　　(ByVal Sh As Object, ByVal Target As Hyperlink)
　　If Not Sh.Name = cMOKUJI Then
　　　　Exit Sub
　　End If
　　' シートを表示する
　　Me.Worksheets(Split(Target.SubAddress, "!")(0)) _
　　　　.Visible = xlSheetVisible
　　' 目的にシートにジャンプする
　　Application.Goto Range(Target.SubAddress)
End Sub

"目次"というシートにハイパーリンクを作ります。
余分なシートを非表示にするのは、ブックを閉じるときにすることにします。
ブックを開くときにやると、どうしても一瞬見えてしまいますので。

なお、このコードはExcel2000以上でないと動かないと思います。
確か FollowHyperlinkイベントはExcel2000からですから。

ビリー様
早速のレスありがとうございます。
（お礼が遅くなりすみません。）
今週末にわからない記述の意味など調べ、勉強したいと思います。
また、質問させていただくことがあるかと思いますが
宜しくお願い致します。

ビリー様

お世話になります。
お腹の調子はいかがですか？私は少し風邪気味です。
（せっかくのいいお天気でしたのに、家でふせっておりました。。悲）
イベントプロシージャ、今まで Workbook_Openしか使ったことがなく、
勉強になりました。
最初はブックをopenした時点で、目次シート事体を作成・・・と考えていたのですが（コードをコピーペーストすれば、目次シート作成の手間が省ける）、閉じる時点で削除（又は開いた時、作成前に削除）すると、
他全シートを非表示にしているので、必ずエラーになりますね。
ですので、ビリーさんが教えてくださったコードのように、
目次シートがあることが前提で、内容のみ都度作成という方法がいいのですね。ありがとうございました。
補足：目次シートを使用するブックは読み取り専用で開く場合が多く、保存はできない場合が多いです。

また初歩的な質問で恐縮ですが下記、■・◆箇所、教えていただけますでしょうか。

やりたいこと。
目次ハイパーリンクの作成を５シート（もしくは１０シート）ごとに、列を替えて作成するようにしたい。

For Eachループのネストなど色々やってみたのですが、
うまくいきませんでした。
◆の変数wkRowの箇所を　for i=3to7　←こんな感じで動かしたいのです。For Eachループ、使うのがほとんど初めてなので、勝手が全くわかりません・・・質問がおかしいかもしれませんが、宜しくお願い致します。


Private Sub Workbook_Open()
Dim shtMOKUJI As Worksheet
Dim i As Worksheet
Dim wkRow As Long
Dim j As Variant, N As Variant

Set shtMOKUJI = Me.Worksheets(cMOKUJI)
shtMOKUJI.Cells.Clear
shtMOKUJI.Cells(1, "A").Value = "目次 クリックしたシートに飛びます。"
wkRow = 1

N = Me.Worksheets.Count

For j = 3 To 3 + (N \ 5 + 1) Step 2　■列

For Each i In Me.Worksheets 'i=ワークシートの数
If Not i.Name = cMOKUJI Then '1回目i=1 シート名が"目次"以外なら
wkRow = wkRow + 1 '変数wkRow+1　すなわち1回目=2となる

'目次シートにハイパーリンクを作成。1回目=A列2行目
shtMOKUJI.Hyperlinks.Add _
Anchor:=shtMOKUJI.Cells(wkRow, j) _◆
, Address:="" _
, SubAddress:=i.Name & "!A1" _
, TextToDisplay:=i.Name

End If
Next i
Next j

End Sub

実は、For Each 〜 Nextはシートに対してループさせているだけなので、今回の修正のポイントではありません。
寧ろ、wkRowでカウントしているところが注目すべきポイントです。

例えば、3シートずつにしたいなら、カウントが増える度に
0　…　1列目−1行目
1　…　1列目−2行目
2　…　1列目−3行目
3　…　2列目−1行目
4　…　2列目−2行目
5　…　2列目−3行目
6　…　3列目−1行目
7　…　3列目−2行目
8　…　3列目−3行目
となればいいですね？
そのためには、商と剰余を利用すればいいです。
試しにこう↓してみてください。
Private Sub Workbook_Open()
　　Dim i As Worksheet
　　Dim wkCount As Long
　　Dim wkRow As Long
　　Dim wkColumn As Long
　　Const cRowCount As Long = 3

　　wkCount = -1
　　For Each i In Me.Worksheets
　　　　If Not i.Name = cMOKUJI Then
　　　　　　wkCount = wkCount + 1
　　　　　　wkColumn = (wkCount \ cRowCount) + 1
　　　　　　wkRow = (wkCount Mod cRowCount) + 1
　　　　　　MsgBox wkCount & vbCrLf _
　　　　　　　　 & i.Name & vbCrLf _
　　　　　　　　 & wkColumn & "列目" & vbCrLf _
　　　　　　　　 & wkRow & "行目"
　　　　End If
　　Next i
End Sub
これでメッセージが思ったとおりに出るなら、行と列の位置は分かりますね？
でも、１行目からハイパーリンクを作ってしまうのは拙いので、
　　　　　　wkRow = (wkCount Mod cRowCount) + 2
にして、２行目からにするのがおそらく妥当でしょう。

これを踏まえて、元のコードを直すと、
Private Sub Workbook_Open()
　　Dim shtMOKUJI As Worksheet
　　Dim i As Worksheet
　　Dim wkCount As Long
　　Dim wkRow As Long
　　Dim wkColumn As Long
　　Const cRowCount As Long = 3

　　Set shtMOKUJI = Me.Worksheets(cMOKUJI)
　　shtMOKUJI.UsedRange.Clear
　　shtMOKUJI.Cells(1, "A").Value = "目次"

　　' セルにハイパーリンクを設定する
　　wkCount = -1
　　For Each i In Me.Worksheets
　　　　If Not i.Name = cMOKUJI Then
　　　　　　wkCount = wkCount + 1
　　　　　　wkColumn = (wkCount \ cRowCount) + 1
　　　　　　wkRow = (wkCount Mod cRowCount) + 2
　　　　　　shtMOKUJI.Hyperlinks.Add _
　　　　　　　　Anchor:=shtMOKUJI.Cells(wkRow, wkColumn) _
　　　　　　 , Address:="" _
　　　　　　 , SubAddress:=i.Name & "!A1" _
　　　　　　 , TextToDisplay:=i.Name
　　　　End If
　　Next i
End Sub
となります。

なお、３行毎に列を変えるのではなく、５行毎にしたいなら、
　　Const cRowCount As Long = 3
を
　　Const cRowCount As Long = 5
にすればいいです。

ビリー様
丁寧に説明してくださって、ありがとうございます！
大変わかりやすく、助かります。

定数を　Const cRowCount As Long = 3 こういう風に使い、
行・列の（剰余系を使った）変化ができるんですね！なるほど！！
　　　　　wkColumn = (wkCount \ cRowCount) + 1
　　　　　wkRow = (wkCount Mod cRowCount) + 2

まだ勉強できてない箇所がたくさんありますので、
また質問させていただくかと思いますが宜しくお願い致します。
とり急ぎお礼まで。

Private Sub Workbook_Open()
Dim shtMOKUJI As Worksheet
Dim i As Worksheet
Dim wkCount As Long
Dim wkRow As Long
Dim wkColumn As Long
Const cRowCount As Long = 10 'ﾊｲﾊﾟｰﾘﾝｸ作成1列の行数

Set shtMOKUJI = Me.Worksheets(cMOKUJI)
shtMOKUJI.UsedRange.Clear
shtMOKUJI.Cells(2, "B").Value = "****** 目次 ******"
Cells(2, "B").HorizontalAlignment = xlCenter
With shtMOKUJI.Cells(2, "B").Font
.Bold = True
.ColorIndex = 9
.Size = 16
End With
shtMOKUJI.Cells(2, "C").Value = "※クリックしたシートに飛びます。"


' セルにハイパーリンクを設定する
wkCount = -1
For Each i In Me.Worksheets
If Not i.Name = cMOKUJI Then 'シート名が"目次"以外ならﾘﾝｸ作成
wkCount = wkCount + 1 '1回目-1+1=0　2回目0+1=1
wkColumn = (wkCount \ cRowCount) + 2 '1回目 0/10+2=2　2回目 1/10+2=2
wkRow = (wkCount Mod cRowCount) + 4 '1回目 0Mod10+4=4　2回目 1Mod10+4=5

'1回目 cells(4,2) 2回目 cells(5,2)
shtMOKUJI.Hyperlinks.Add _
Anchor:=shtMOKUJI.Cells(wkRow, wkColumn) _
, Address:="" _
, SubAddress:=i.Name & "!A1" _
, TextToDisplay:=i.Name

With Cells(wkRow, wkColumn).Font
.Size = 13
.ColorIndex = 11
End With
End If
Next i

With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With

Cells.Select
Selection.Interior.ColorIndex = 19
Cells.EntireColumn.AutoFit
Selection.RowHeight = 22
Range("A1").Select

End Sub

ビリー様

お世話になります。
下記、■箇所でエラーがでてしまい、修正ができません。。。
また、お時間のおありのときで結構ですので、教えていただけますでしょうか。
宜しくお願い致します。

Private Sub Workbook_SheetFollowHyperlink _
(ByVal Sh As Object, ByVal Target As Hyperlink)
'SheetFollowHyperlinkｲﾍﾞﾝﾄ　Excel のハイパーリンクをクリックすると発生。

If Not Sh.Name = cMOKUJI Then 'シート名が"目次"以外ならExit Sub
Exit Sub
End If
' シートを表示する
Me.Worksheets(Split(Target.SubAddress, "!")(0)).Visible = xlSheetVisible
'Split 関数　各要素ごとに区切られた文字列から1 次元配列を作成し返す。

' 目的シートにジャンプする
Application.Goto Range(Target.SubAddress) '■シート名に()が含まれているとエラー ：参照が正しくありません。

End Sub

ワークシート名によっては、' でくくられる場合があるので
すが、そのようなケースにおいてハイパーリンクが正しく張
られないようですね。
これは、Workbook_SheetFollowHyperlinkプロシージャに問題
があるのではなく、Workbook_Openプロシージャに問題があり
ます。（Workbook_SheetFollowHyperlinkプロシージャを削除
してもエラーが出ることから明らかです。）

という訳で、Workbook_Openプロシージャ内の
>　　, SubAddress:=i.Name & "!A1" _
を
　　, SubAddress:="'" & i.Name & "'!A1" _
にしてみてください。

ついでに、Workbook_SheetFollowHyperlinkプロシージャも
これに合わせて、逆に ' を取るようにしておきます。
Private Sub Workbook_SheetFollowHyperlink _
　　　　(ByVal Sh As Object, ByVal Target As Hyperlink)
　　Dim SheetName As String

　　If Not Sh.Name = cMOKUJI Then
　　　　Exit Sub
　　End If
　　SheetName = Split(Target.SubAddress, "!")(0)
　　SheetName = Mid(SheetName, 2, Len(SheetName) - 2)
　　' シートを表示する
　　Me.Worksheets(SheetName).Visible = xlSheetVisible
　　' 目的にシートにジャンプする
　　Application.Goto Range(Target.SubAddress)
End Sub

ビリー様
上記ありがとうございました。
無事、シートにとぶことができました。
＞ワークシート名によっては、' でくくられる場合がある
そうなんですか。難しいですね・・・トホホ
仕事でも、' や空白が入ったものなんかにいつも悩まされることが多いです。
For eachループ、なかなかなれなくて難しいです。
また質問させていただくことがあるかもしれませんが、
宜しくお願い致します。

ビリー様
いつもお世話になります。
下記◆〜◆のコードでまたご享受願えますでしょうか。

やりたいこと。
目次以外のシートに一番上に1行挿入し、A1セルに"目次へ戻る"
ハイパーリンクを作成したい。

できることはできるのですが、今度は閉じる時に非表示になっていたシートが全部見えてしまいます。
読み取り専用で開くシートですので、保存はできません。
宜しくお願いします。


Private Sub Workbook_Open()
Dim shtMOKUJI As Worksheet
Dim i As Worksheet
Dim wkCount As Long
Dim wkRow As Long
Dim wkColumn As Long
Const cRowCount As Long = 10 'ﾊｲﾊﾟｰﾘﾝｸ作成1列の行数

Application.ScreenUpdating = False

Set shtMOKUJI = Me.Worksheets(cMOKUJI)
shtMOKUJI.UsedRange.Clear
shtMOKUJI.Cells(2, "B").Value = "****** 目次 ******"
Cells(2, "B").HorizontalAlignment = xlCenter
With shtMOKUJI.Cells(2, "B").Font
.Bold = True
.ColorIndex = 9
.Size = 16
End With
shtMOKUJI.Cells(2, "C").Value = "※クリックしたシートに飛びます。"

' セルにハイパーリンクを設定する
wkCount = -1
For Each i In Me.Worksheets
If Not i.Name = cMOKUJI Then 'ｼｰﾄ名が"目次"以外ならﾘﾝｸ作成。(目次ﾍﾟｰｼﾞに目次ﾍﾟｰｼﾞへのﾘﾝｸはいらない)
wkCount = wkCount + 1 '1回目-1+1=0　2回目0+1=1
wkColumn = (wkCount \ cRowCount) + 2 '1回目 0/10+2=2　2回目 1/10+2=2
wkRow = (wkCount Mod cRowCount) + 4 '1回目 0Mod10+4=4　2回目 1Mod10+4=5

'1回目 cells(4,2) 2回目 cells(5,2)
shtMOKUJI.Hyperlinks.Add _
Anchor:=shtMOKUJI.Cells(wkRow, wkColumn) _
, Address:="" _
, SubAddress:="'" & i.Name & "'!A1" _
, TextToDisplay:=i.Name

With Cells(wkRow, wkColumn).Font
.Size = 13
.ColorIndex = 11
End With

◆ i.Activate
If Cells(1, 1) = "目次へ戻る" Then 'もしA1ｾﾙが "目次へ戻る"なら
Rows(1).Delete '1行目を削除する
End If
'cells(1,1)に目次へのﾘﾝｸを作成する
Rows("1:1").Select '1行足す
Selection.Insert Shift:=xlDown
Cells(1, 1).Activate
ActiveSheet.Hyperlinks.Add _
Anchor:=ActiveSheet.Cells(1, 1) _
, Address:="" _
, SubAddress:="'" & shtMOKUJI.Name & "'!A1" _
, TextToDisplay:="目次へ戻る"
◆ shtMOKUJI.Activate

End If
Next i

With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With

Cells.Select
Selection.Interior.ColorIndex = 19
Cells.EntireColumn.AutoFit
Selection.RowHeight = 22
Range("A1").Select

Application.ScreenUpdating = True

End Sub

ハイパーリンクを張るためにシートを選択する必要はありません。
不要なSelectを削除して、Cellsの前にどのシートなのか指定してやればいいと思いますよ。

Const cMOKUJI As String = "目次"

Private Sub Workbook_Open()
　　Dim shtMOKUJI As Worksheet
　　Dim i As Worksheet
　　Dim wkCount As Long
　　Dim wkRow As Long
　　Dim wkColumn As Long
　　Const cRowCount As Long = 10 'ﾊｲﾊﾟｰﾘﾝｸ作成1列の行数

　　Application.ScreenUpdating = False

　　Set shtMOKUJI = Me.Worksheets(cMOKUJI)
　　shtMOKUJI.UsedRange.Clear
　　shtMOKUJI.Cells(2, "B").Value = "****** 目次 ******"
　　shtMOKUJI.Cells(2, "B").HorizontalAlignment = xlCenter
　　With shtMOKUJI.Cells(2, "B").Font
　　　　.Bold = True
　　　　.ColorIndex = 9
　　　　.Size = 16
　　End With
　　shtMOKUJI.Cells(2, "C").Value = "※クリックしたシートに飛びます。"
　　
　　wkCount = -1
　　For Each i In Me.Worksheets
　　　　' 目次シート以外の場合
　　　　If Not i.Name = cMOKUJI Then
　　　　　　' #### 目次シートのハイパーリンク ####
　　　　　　wkCount = wkCount + 1
　　　　　　wkColumn = (wkCount \ cRowCount) + 2
　　　　　　wkRow = (wkCount Mod cRowCount) + 4
　　　　　　' 目次シートにハイパーリンクを張る
　　　　　　shtMOKUJI.Hyperlinks.Add _
　　　　　　　　Anchor:=shtMOKUJI.Cells(wkRow, wkColumn) _
　　　　　　　, Address:="" _
　　　　　　　, SubAddress:="'" & i.Name & "'!A1" _
　　　　　　　, TextToDisplay:=i.Name
　　　　　　With shtMOKUJI.Cells(wkRow, wkColumn).Font
　　　　　　　　.Size = 13
　　　　　　　　.ColorIndex = 11
　　　　　　End With

　　　　　　' #### 目次シート以外のハイパーリンク ####
　　　　　　If i.Cells(1, 1).Text = "目次へ戻る" Then
　　　　　　　　i.Cells(1, 1).Clear
　　　　　　Else
　　　　　　　　i.Rows("1:1").Insert Shift:=xlDown
　　　　　　End If
　　　　　　' 目次シート以外に目次へのﾘﾝｸを作成する
　　　　　　i.Cells(1, 1).Hyperlinks.Add _
　　　　　　　　Anchor:=i.Cells(1, 1) _
　　　　　　　, Address:="" _
　　　　　　　, SubAddress:="'" & cMOKUJI & "'!A1" _
　　　　　　　, TextToDisplay:="目次へ戻る"
　　　　End If
　　Next i

　　With ActiveWindow
　　　　.DisplayGridlines = False
　　　　.DisplayHeadings = False
　　End With
　　With shtMOKUJI.Cells
　　　　.Interior.ColorIndex = 19
　　　　.EntireColumn.AutoFit
　　　　.RowHeight = 22
　　End With
　　Application.Goto shtMOKUJI.Range("A1")
　　
　　Application.ScreenUpdating = True
End Sub

ビリー様
早速のお返事ありがとうございました。
明日、ゆっくり勉強させていただきたいと思います。
ところで、地震は大丈夫でしたか？
阪神淡路大震災のときは、わたしのところはすごく揺れて
恐ろしかったのを覚えてます。
くれぐれも家具は固定を・・・
とり急ぎお礼まで。

For Eachループについてちょいと解説させてもらいましょう。
VBにはコレクションと言う概念があります。
複数のオブジェクトを束ねて一つにする。
言うたらオブジェクトの配列ですな。
Workbookオブジェクト=WorkSheetsコレクションは
WorkSheetオブジェクトの集まり。
WorkSheetオブジェクトはCellsの集まり（こっちは厳密には違いますけど、あくまで概念論ですので）
そういう事を踏まえると以下の物も考え的にはなにも変わらない事に気がつかれると思います。

(1)
Dim CurSht as WorkSheet
Dim ShtCnt as Integer

For Each CurSht in WorkSheets
CurSht.name= ShtCnt
ShtCnt=ShtCnt+1
Next CurSht

(2)
sheets(1).name=1
sheets(2).name=2
・
・
・

ちなみにFor Each ループは普通のForループでも再現可能です。
上記の(１)を置き換えるとこうなりますな。

For i =1 to WorkSheets.Count
WorkSheets(i).name= i
Next CurSht

てなトコでまず。

>上記の(１)を置き換えるとこうなりますな。
>
>For i =1 to WorkSheets.Count
>WorkSheets(i).name= i
>Next CurSht

私の見立てでは、
For i = 1 to WorkSheets.Count
　　WorkSheets(i).name= i - 1
Next i
だと思うのですが･･･

めんどーなので、直書き＆机上デバッグしかしていません。
実行していないので、違っていたらあしからず♪
でも、少なくともNext CurShtはコンパイルエラーになるはず。

Next CurShtはかきまちがいちがいっす。
あくまで、コレクションの概念解説ととって下さい。
職業プログラマーとしてコレが結構重要やと思てますんで。

[羽]e-bow様、ビリー様

お礼が遅くなってしまいすみません。
For Eachループの解説ありがとうございます。
Forループか、do while ループ（このへんの）しか
使ったことがなくって、しかも置き換えもままならず・・・

＞VBにはコレクションと言う概念があります。
＞複数のオブジェクトを束ねて一つにする。
＞言うたらオブジェクトの配列ですな。

概念をしっかり頭に入れておいて、少しずつ使って覚えて行こうと
思います。
また宜しくお願いします。