[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『目次を作りたいのですが』（辛汗）
シートがたくさんあり、そのシート名を新シートに表記（目次）させたいのですが、なにか良い方法はありますでしょうか？
シート選びは出来るのですが、「印刷したい」というところで・・
普通にサクサクと目次を作れば良いのですが、ブックもたくさんありまして・・
宜しくお願いします。
該当Bookの標準モジュールに入れて実行してみてください。
Sub test1()
'目次作成
Dim ws As Worksheet
Dim i As Integer
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = "目次"
i = 1
For Each ws In ActiveWorkbook.Sheets
Cells(i, 1).Value = ws.Name
i = i + 1
Next
End Sub
（川野鮎太郎）
横からすみません、教えてください。 一度、目次を作成してから、シート名が増えて再度実行するとエラーになります。 目次シートが既にある場合のコードは、どうしたらいいのでしょうか。 (代奈)
あいた〜ｗΣ(ノ∀｀)ペチ。 その目次シートを消す！ってのはだめですか(^_^A; または、シート名を変えてみるとか・・・ （川野鮎太郎）
そうですね、わかりました。 では目次シートを手動で消してから実行します(^^) シートを削除するコードとかメッセージボックスを出すコードとか 一人であれこれ考えて分からなかったものですから。。。 有難うございましたm(__)m (代奈)
川野さんのコードをお借りして Sub test1()
Dim ws As Worksheet Dim i As Integer
Application.DisplayAlerts = False
On Error Resume Next
Sheets("目次").Delete
ActiveWorkbook.Sheets.Add before:=Worksheets(1)
ActiveSheet.Name = "目次"
i = 1
For Each ws In ActiveWorkbook.Sheets
Cells(i, 1).Value = ws.Name
i = i + 1
Next
Application.DisplayAlerts = True
End Sub こんな感じでどうでしょう？ （ケン）
ケンさんフォローありがとうございますm(_ _)m
番号追加ってことで(^_^A; Sub test1() '目次作成 Dim ws As Worksheet Dim i As Integer ActiveWorkbook.Sheets.Add If ActiveSheet.Name = "目次" Then
ActiveSheet.Name = "目次"
Else
ActiveSheet.Name = "目次(1)"
i = 1
For Each ws In ActiveWorkbook.Sheets
Cells(i, 1).Value = ws.Name
i = i + 1
Next
End If
End Sub
じゃあ、目次(1)ってあった場合は？ ってのは、無しの方向で＿/￣|○ il||li （川野鮎太郎）
ケンさんありがとうございました(^^) 目次シートを削除して下さったのですね、うまくいきました! 川野さん...すみません、目次がないのに「目次(1)」って表示されちゃいます... 私のやり方が悪いのでしょうか？ (代奈)
(T▽T)アハハ!すいませんさっきの忘れてください。 あわてたもので、よく見てませんでした＿/￣|○ il||li （川野鮎太郎）
あの...ごめんなさい。 最近、川野さんの＿/￣|○ il||liこのポーズをよく見かけます。 下記でうまく行きました、すみませんでした。 元気だして下さいね...
Sub test1() '目次作成 Dim ws As Worksheet Dim i As Integer ActiveWorkbook.Sheets.Add If ActiveSheet.Name = "目次" Then
ActiveSheet.Name = "目次(1)"
Else
ActiveSheet.Name = "目次(1)"
i = 1
For Each ws In ActiveWorkbook.Sheets
Cells(i, 1).Value = ws.Name
i = i + 1
Next
End If End Sub
あれ...おかしいな...うまくいかない... んんん。さっきはうまくいったのに (代奈＠格闘中)
VBAでない方法 一番左側のシートを「目次」という名前のシートとします。 「挿入」＞「名前」＞「定義」で下記の関数に名前を付けます。
シートの一行目に =ShName と入力してこれをずりずりずりーっと下の行へコピー、貼付します。 多目でかまいません。 残念ながら、自動再計算にはならないので、シート追加した時には F9キーを押すなどして再計算を実行してください。 (KAMIYA)
す...すごいですね(>_<) 参照範囲の式を理解するのも難しいくらいハイテク(裏テク？)レベルで...！ でも、うまくいきました...どういう仕組みなのでしょう？ 奥が深すぎて光が見えないかも...です... その上、自動再計算になりました！ (代奈)
裏テク中の裏テク、4.0マクロ関数です。 Excelが非対応になるのも間近と思いますので、 将来のことを考えるとどうかとも思いますが・・・。 GET.WORKBOOK関数 ヘルプには載っていません。 とりあえず、使えそうな引数のみ抜粋。
(KAMIYA)
一応作ってみました(*´ﾉｪ｀)コソーリ
Sub test2() '目次作成 Dim ws As Worksheet Dim i As Integer
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Sheets
If ws.Name = "目次" Then
msg = MsgBox("目次シートが存在します！" & Chr(13) & Chr(13) & "シートを削除しますか？" & Chr(13) & "いいえの場合には目次(1)になります。", vbYesNo)
If msg = vbYes Then
Sheets("目次").Delete
Else
wsname = "目次(1)"
Exit For
End If
wsname = "目次"
End If
Next
ActiveWorkbook.Sheets.Add before:=Worksheets(1)
ActiveSheet.Name = wsname
i = 1
For Each ws In ActiveWorkbook.Sheets
Cells(i, 1).Value = ws.Name
i = i + 1
Next
Application.DisplayAlerts = True
End Sub
（川野鮎太郎）
KAMIYAさん、どこでそんな技を... 4.0マクロ関数？マクロと関数の合体形があるんですね、無知でした(>_<) 調べてみることにします。
川野さん...うう...な、なぜ... ActiveSheet.Name = wsname で実行時エラー1004が...(T_T) (代奈)
!?工エエェ(ﾟ〇ﾟ ；)ェエエ工!? ま・ま・まさか・・・ 目次(1)のシートがあるのに、いいえを選択したとか・・・＿/￣|○ il||li （川野鮎太郎）
＞4.0マクロ関数？マクロと関数の合体形があるんですね、無知でした(>_<) Excel5以前のマクロ言語です。知らなくて当然です。シート上では使えません。 以前のヴァージョンの互換性のためだけに残されている機能なので、 いつ非対応になってもおかしくありません。 Lotus花盛りの頃の機能なので、Web情報も多くありません。 個人的にはマクロでも難しい機能が実現できたりで重宝しているのですが。
To 川野さん Deleteにこだわりがあるようですが、 「目次」シートがなければ「目次」シートを追加、 あった場合は既存のデータをクリア、 データを再取得、という方法ではだめなの？ Sub MOKUJI() Dim Ws As Worksheet Dim flag As Boolean Dim i As Long
For Each Ws In Worksheets
If Ws.Name = "目次" Then
Ws.Range("A:A").ClearContents
flag = True
Exit For
End If
Next Ws
If flag = False Then
Set Ws = ThisWorkbook.Worksheets.Add(before:=Worksheets(1))
Ws.Name = "目次"
End If
For i = 1 To Worksheets.Count
Ws.Cells(i, 1).Value = Worksheets(i).Name
Next i
End Sub
(KAMIYA)
いえいえ、こだわりがあるというわけでは無いのですが、使う方の構成によって目次の目次が必要な場合もあるのかなと思い、 残したいかどうかを判断できようようにした次第です(^_^A; （川野鮎太郎）
エラートラップを使ったサンプルです。ご参考までに・・・。
Sub Sample() Dim ws As Worksheet Dim i As Long Dim wsName As String: wsName = "目次"
With ActiveWorkbook
'シート追加
Set ws = .Sheets.Add(before:=Worksheets(1))
On Error GoTo ErrTrap
ws.Name = wsName 'シート名の設定
On Error GoTo 0
'シート名取得
For i = 1 To .Sheets.Count
ws.Cells(i + 1, 1).Value = .Sheets(i).Name
Next
ws.Range("A1").Value = "シート名"
ws.Columns(1).AutoFit
MsgBox wsName & "シートを作成しました", , "目次作成"
Exit Sub 'マクロ終了
'================================-
ErrTrap: '重複シート処理
If vbYes = MsgBox(wsName & "シートは既にあります。削除して作り直してもいいですか？" _
, vbYesNo + vbQuestion) Then
Application.DisplayAlerts = False
.Sheets(wsName).Delete 'シート削除
Application.DisplayAlerts = True
Else
i = i + 1
wsName = "目次_" & i 'シート名に連番付与
End If
Resume
End With End Sub
(INA)
INAさん、さすがです。(_ _ ;)尸"マイリマシタ･･･
いくつ目次が増えても良いようになってるんですね。。。
エラーとラップですか・・・＿〆＼(．．;) メモメモ
エラーが怒ったら、ラップでなだめるんですね。。。 （失礼(^_^A;）
というか、またもやスレ主さんと関係ないところで長いレスをしてしまいました(^_^A;
（川野鮎太郎）
KAMIYAさん、エレガントな作品有難うございました。 関数、マクロ、書式etc.全般に通じておられ、驚くばかりです。 INAさん、見事としか言いようのない作品、有難うございました。 使用者の立場になり、細部まで心配りされており、素晴らしいと思いました。 川野さん、VBAって、楽しいですね！(川野さんも(*^^*)) このサイトを拝見するようになってから、VBAに興味を持ちました。 ご提示頂きました貴重なコード、一つ一つを紐解いて身になるようにしたいと思います。 有難うございました (代奈)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.