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



<基本操作編 その3>



Sub コメントを表示非表示() '21戻る
'コメントを表示しない、マークだけ、表示、と切り替えます
    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




トップページへ戻る