次の方法で共有


目次をブックに追加する

次の使用例では、目次を Excel ブックに追加するさまざまな方法を示します。

サンプル コードの提供元: Dennis Wallentin、VSTO & .NET & Excel

この例では、 Pages.Count プロパティ (Excel) プロパティ を使用して、各シートのページ数を計算します。 さらに、各シートに対する TOC リンクのエントリを使用して、画面上でのブックの移動処理を向上させます。

Option Explicit 
Sub Create_TOC() 
Dim wbBook As Workbook 
Dim wsActive As Worksheet 
Dim wsSheet As Worksheet 
Dim lnRow As Long 
Dim lnPages As Long 
Dim lnCount As Long 
Set wbBook = ActiveWorkbook 
With Application 
    .DisplayAlerts = False 
    .ScreenUpdating = False 
End With 
'If the TOC sheet already exist delete it and add a new 
'worksheet. 
On Error Resume Next 
With wbBook 
    .Worksheets("TOC").Delete 
    .Worksheets.Add Before:=.Worksheets(1) 
End With 
On Error GoTo 0 
Set wsActive = wbBook.ActiveSheet 
With wsActive 
    .Name = "TOC" 
    With .Range("A1:B1") 
        .Value = VBA.Array("Table of Contents", "Sheet # - # of Pages") 
        .Font.Bold = True 
    End With 
End With 
lnRow = 2 
lnCount = 1 
'Iterate through the worksheets in the workbook and create 
'sheetnames, add hyperlink and count & write the running number 
'of pages to be printed for each sheet on the TOC sheet. 
For Each wsSheet In wbBook.Worksheets 
    If wsSheet.Name <> wsActive.Name Then 
        wsSheet.Activate 
        With wsActive 
            .Hyperlinks.Add .Cells(lnRow, 1), "", _ 
            SubAddress:="'" & wsSheet.Name & "'!A1", _ 
            TextToDisplay:=wsSheet.Name 
            lnPages = wsSheet.PageSetup.Pages().Count 
            .Cells(lnRow, 2).Value = "'" & lnCount & "-" & lnPages 
        End With 
        lnRow = lnRow + 1 
        lnCount = lnCount + 1 
    End If 
Next wsSheet 
wsActive.Activate 
wsActive.Columns("A:B").EntireColumn.AutoFit 
With Application 
    .DisplayAlerts = True 
    .ScreenUpdating = True 
End With 
End Sub

提供されるサンプル コード: Bill Jelen,MrExcel.com この例では、"TOC" という名前のシートが既に存在することを確認します。 存在する場合は、目次が更新されます。 存在しない場合は、ブックの最初に新しい TOC シートが作成されます。 各シートの名前と、それぞれのページ番号が目次に一覧表示されます。 ページ番号を取得するために、[印刷プレビュー] ダイアログ ボックスが開きます。 このダイアログ ボックスを閉じると、目次が作成されます。

Sub CreateTableOfContents() 
    ' Determine if there is already a Table of Contents 
    ' Assume it is there, and if it is not, it will raise an error 
    ' if the Err system variable is > 0, you know the sheet is not there 
    Dim WST As Worksheet 
    On Error Resume Next 
    Set WST = Worksheets("TOC") 
    If Not Err = 0 Then 
        ' The Table of contents doesn't exist. Add it 
        Set WST = Worksheets.Add(Before:=Worksheets(1)) 
        WST.Name = "TOC" 
    End If 
    On Error GoTo 0 
     
    ' Set up the table of contents page 
    WST.[A2] = "Table of Contents" 
    With WST.[A6] 
        .CurrentRegion.Clear 
        .Value = "Subject" 
    End With 
    WST.[B6] = "Page(s)" 
    WST.Range("A1:B1").ColumnWidth = Array(36, 12) 
    TOCRow = 7 
    PageCount = 0 
 
    ' Do a print preview on all sheets so Excel calcs page breaks 
    ' The user must manually close the PrintPreview window 
    Msg = "Excel needs to do a print preview to calculate the number of pages. " 
    Msg = Msg & "Please dismiss the print preview by clicking close." 
    MsgBox Msg 
    ActiveWindow.SelectedSheets.PrintPreview 
 
    ' Loop through each sheet, collecting TOC information 
    For Each S In Worksheets 
        If S.Visible = -1 Then 
            S.Select 
            ThisName = ActiveSheet.Name 
            HPages = ActiveSheet.HPageBreaks.Count + 1 
            VPages = ActiveSheet.VPageBreaks.Count + 1 
            ThisPages = HPages * VPages 
 
            ' Enter info about this sheet on TOC 
            Sheets("TOC").Select 
            Range("A" & TOCRow).Value = ThisName 
            Range("B" & TOCRow).NumberFormat = "@" 
            If ThisPages = 1 Then 
                Range("B" & TOCRow).Value = PageCount + 1 & " " 
            Else 
                Range("B" & TOCRow).Value = PageCount + 1 & " - " & PageCount + ThisPages 
            End If 
        PageCount = PageCount + ThisPages 
        TOCRow = TOCRow + 1 
        End If 
    Next S 
End Sub

投稿者について

Dennis Wallentin は、Excel および Excel Services の .NET Framework ソリューションを重点的に扱うブログである VSTO & .NET & Excel の作者です。 Dennis は 20 年以上 Excel ソリューションを開発しており、また『Professional Excel Development: The Definitive Guide to Developing Applications Using Microsoft Excel, VBA, and .NET (2nd Edition)』の共著者でもあります。

MVP Bill Jelen は Microsoft Excel に関する書籍を 25 冊以上執筆しています。 Bill は Leo Laporte と共に TechTV の常連ゲストであり、MrExcel.com のホストでもあります。MrExcel.com には Excel に関する 300,000 件以上の質問と回答が掲載されています。

サポートとフィードバック

Office VBA またはこの説明書に関するご質問やフィードバックがありますか? サポートの受け方およびフィードバックをお寄せいただく方法のガイダンスについては、Office VBA のサポートおよびフィードバックを参照してください。