codeなにがし::Excelシートのプレビュー目次を生成する

Excelシートのプレビュー目次を生成する: kumazo

ソースコードID：　553
登録日時：　2008/06/24 12:57
最終更新日時：　2008/06/24 21:32
アクセス数：　481
タグ：　 vba excel マクロ

0 users

説明

ワークシートのプレビュー（縮小イメージ）をリンクつきで生成して並べるマクロです。

使い方は、まず目次にしたいシートで適当な大きさのセル範囲を選択します。これがプレビューイメージのサイズの目安になります。

次にマクロを実行すると、そのシートの後ろにあるすべてのワークシートのプレビューオブジェクトが縦方向に展開されます。

プレビューにはリンクがついているので、クリックするとそのワークシートが開きます。

このプレビューは"生きて"います。つまり、元のシートの変更内容が反映されます。

Excel 2003 で動作確認しています。

ソースコード

履歴表示コピペ用

Sub HyperPreview()

    Dim baseSheet As Worksheet
    Dim frameRange As Range
    Dim previewImage As ShapeRange
    
    Set baseSheet = ActiveSheet
    Set frameRange = ActiveWindow.RangeSelection
    
    Application.ScreenUpdating = False

    For i = baseSheet.Index + 1 To Worksheets.Count
    
        Worksheets(i).Activate
        
        ActiveWindow.VisibleRange.Copy
        Set previewImage = baseSheet.Pictures.Paste(Link:=True).ShapeRange
                        
        With previewImage
            .LockAspectRatio = msoTrue
            .Top = frameRange.Top
            .Width = frameRange.Width
            .Fill.Visible = msoTrue
            .Line.Visible = msoTrue
            .Shadow.Type = msoShadow14
            .Name = ActiveSheet.Name
        End With
        
        baseSheet.Hyperlinks.Add _
            Anchor:=previewImage.Item(1), _
            Address:="", _
            SubAddress:="'" & ActiveSheet.Name & "'!A1"

        Set frameRange = frameRange.Offset(frameRange.Rows.Count, 0)
    Next
    
    baseSheet.Activate
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub