excel

2009年11月14日 (土)

エクセルでシートごとへのリンクの一覧を作成する。

データベースの各テーブルの説明がエクセルのシートごとに記述されていたが、
希望のテーブルのシートを探すのにすごく手間取る。
そこで、先頭にシート一覧というシートを作成し、そのシートに各シートへのリンクした一覧をつける
マクロを作成した。
ただ、めっちゃ遅い。40枚ぐらいシートがあると、4~5分応答が返ってこない。

Sub sheet_list()
    Dim find As Boolean
    Dim cnt As Integer
    
    find = SearchSheet("リンク一覧")
    If find = False Then
        Set objWks = ActiveWorkbook.Worksheets.Add(before:=Worksheets(1))
        objWks.name = "リンク一覧"
    End If
    ActiveWorkbook.Worksheets("リンク一覧").Select
    cnt = 1
    Columns("A").ColumnWidth = 40
    For Each i In ActiveWorkbook.sheets
        If i.name <> "リンク一覧" Then
            Rows(cnt).RowHeight = 40
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(cnt, 1), Address:="", _
                SubAddress:="'" & i.name & "'" & "!A1", TextToDisplay:=i.name
            Cells(cnt, 1).Font.Size = 16
            cnt = cnt + 1
        End If
    Next i
End Sub
Function SearchSheet(name As String) As Boolean
    'シート数取得
    Dim intIdx As Integer
    Dim intWksCnt As Integer
    
    intIdx = 1
    intWksCnt = Excel.ActiveWorkbook.Worksheets.Count
    Do While intIdx <= intWksCnt
        If Worksheets(intIdx).name = name Then
            SearchSheet = True
            Exit Function
        End If
        intIdx = intIdx + 1
    Loop
    SearchSheet = False
End Function

| | コメント (0) | トラックバック (0)