エクセル VBA マクロ　基本操作編　３

[TOP][基本操作] [関数] [お遊び] [マクロを登録][ユーザー定義表示形式][自作メニュー]

<基本操作編　その３>

'コメントを表示しない、マークだけ、表示、と切り替えます
    Select Case Application.DisplayCommentIndicator
        Case xlNoIndicator
            Application.DisplayCommentIndicator = xlCommentIndicatorOnly
        Case xlCommentIndicatorOnly
            Application.DisplayCommentIndicator = xlCommentAndIndicator
        Case xlCommentAndIndicator
            Application.DisplayCommentIndicator = xlNoIndicator
        Case Else
            Application.DisplayCommentIndicator = xlNoIndicator
    End Select
End Sub

Sub 画面拡大() '「表示」メニューのズームを均等率で変更します

'ちょっとずつ拡大したいとき
    Const RITU = 10 '拡大率

    ActiveWindow.Zoom = ActiveWindow.Zoom + RITU
End Sub

Sub 画面縮小()

'ちょっとずつ縮小したいとき
    Const RITU = 10 '縮小率

    If ActiveWindow.Zoom <= (RITU + 5) Then Exit Sub 'マイナスにならないよう
    ActiveWindow.Zoom = ActiveWindow.Zoom - RITU
End Sub

Sub カレントディレクトリ戻す()

    Const MYDIR = "C:\My Documents" '適当に変更
    'ドライブを含めて指定します
    'いつも使うフォルダと違うフォルダからファイルを開いた時
    'ファイルの履歴がゴチャゴチャするのを、元に戻せます
    ChDrive MYDIR
    ChDir MYDIR
End Sub

Sub シート目次作成()

'ワークシートが多くなりすぎて、移動に不便になったとき、目次シートを冒頭に作ります
'ワークシート名のセルが、そのワークシートにリンクしています
    Const LINKS_SHEET = "目次" '新たに作るワークシート名です
    Const LIST_ROWS = 10 '10行で改行します

    Dim n%, m%, st_count%, rw%, clmn%, sheet_name$, is_mokuji%
    Dim targetcell As Range
    Dim targetsheet As Worksheet

    is_mokuji = 0
    For Each targetsheet In Worksheets
        If targetsheet.Name = LINKS_SHEET Then
            targetsheet.Activate 'すでに同じシート名があれば書き換えます
            is_mokuji = 1
            Exit For
        End If
    Next targetsheet

    If is_mokuji = 0 Then 'なければ「目次」シートを新たに作ります
        Worksheets.Add before:=Worksheets(1)
        Worksheets(1).Name = LINKS_SHEET
    End If
    With ActiveSheet '「目次」シート
        .Cells.ClearContents
        For n = 0 To ThisWorkbook.Worksheets.Count - 2
            rw = n Mod LIST_ROWS + 1
            clmn = n \ LIST_ROWS + 1
            Set targetsheet = ThisWorkbook.Worksheets(n + 2)
            Set targetcell = .Cells(rw, clmn)
            sheet_name = targetsheet.Name
            targetcell.FormulaR1C1 = sheet_name
            sheet_name = "'" & sheet_name & "'" '「'」を付けることで、シート名に（　があったりするとエラーになるのを防ぎます
            sheet_name = sheet_name & "!A1"

            .Hyperlinks.Add Anchor:=targetcell, Address:="", SubAddress:=sheet_name
        Next n
        Cells.EntireColumn.AutoFit
        Range("A1").Select
    End With
End Sub

トップページへ戻る

<基本操作編 その３>

<基本操作編　その３>