【Excelマクロ】現在開いている全エクセルの全SheetのアクティブセルをA1にする【あったら便利かもしれない】

16437 ワード
VBA VBA,Excel Excel VBAマクロ ExcelVBA Excel テキストリンク

変更履歴

  1. 初版作成（2020/10/24）

Introduction

Excel方眼紙問題

設計書、報告書、メモ書き、テストパターンを自作する、毎朝の体温チェック記録、、、
現在は令和2年10月ですが、Excelを見ない日はありません。
世の中の全てがExcelで回っているのかと錯覚するがごとく、Excelを毎日見ます。

そんなある日、全てのエクセルのシートが左上から始まっていれば 綺麗だなと思いました。
（たまに、わけわからん場所が初期表示されてて「？？？」となることがあります）

というか、みんなが適切なツール（Markdownとか）使えばよいのでは

そういうやつ、自動でできる何か、ネットにないか探しました

ありませんでした。
正確には、クリティカルなものがありませんでした。

なお、参考リンクはこの記事の末尾にまとめています。

マクロ（xlsmファイル）を組んで、自分自身（xlsmファイル）のアクティブセルを「A1」にするのは見つかりましたが、
先輩、上司、過去の偉人が作成した【ネ申エクセル】の中にマクロをぶち込むのはちょっと厳しい。

あくまでも、

  • 完成されたxlsxファイルに対し
  • それ自身を改変することなく
  • 外部からちょっとだけいじる

を達成したい。

Programming

今回作成したマクロ有効ブックと同時に、位置調整をかけたいエクセルブックを起動します。
本マクロを起動すると、ダイアログボックスが出現して、、、

「はい」を押すと実行、「いいえ」を押すと実行しません。
処理完了後、次のブックに対し再度チェックを掛けます。

仕様

  • 対象　：　本マクロと同時に開いている全ブック

  • 実行内容

    • アクティブセルを「A1」へ移動
    • 表示倍率を100%に設定
    • アクティブシートを、先頭（一番左の）シートに？　　←要検証
    • 全Bookを最大化表示

実装

  1. ボタンを用意しました

  2. ボタン（名称Button1）を押すと、FixAllBooks()を呼びます。

    ''' *******************************************************
''' <summary>
'''     ボタンをクリック時、各マクロを実行
''' </summary>
''' <remarks>
'''     2020/10/24  初版
''' </remarks>
''' *******************************************************

''' *******************************************************
''' <summary>
'''     開いている全ブックに対し、
'''     全シートのアクティブセルを「A1」に設定し、表示倍率を100%とする。
''' </summary>
''' *******************************************************
Sub Button1_Click()
    Call FixAllBooks
End Sub

  3. FixAllBooks()はFixAllSheets()を呼び、それはFixCellPosition()を呼びます。

    ''' ********************************************************************************
''' <summary>
'''     開いている全ブックに対し、
'''     全シートのアクティブセルを「A1」に設定し、表示倍率を100%とする。
''' </summary>
''' <remarks>
'''     開いているブックを検知し、各ブックに対して『FixAllSheets()』を実行
'''
'''     2020/10/04  初版
''' </remarks>
''' ********************************************************************************
Sub FixAllBooks()
  Dim message As String
  Dim rtn As Integer

  ' 画面更新の停止
  Application.ScreenUpdating = False

  For Each book In Workbooks
    message = "『" & book.Name & "』" & vbCrLf _
                & vbCrLf _
                & "の全シートについて、" & vbCrLf _
                & "アクティブセルをA1セルへ設定し、表示倍率を100%とします。"

    rtn = MsgBox(message, vbYesNo)

    If rtn = vbYes Then
        ' マクロ実行
        book.Activate ' 現在処理中のブックをアクティブに
        Call FixAllSheets
        ActiveWindow.WindowState = xlMaximized  'Excelを最大化

        MsgBox ("実行しました。")
    End If

  Next

  ' 画面更新の再開
  Application.ScreenUpdating = True
End Sub

''' --------------------------------------------------------------------------------
''' <summary>
'''     アクティブなブックに対し、各シートに対して『FixCellPosition()』を実行
''' </summary>
''' --------------------------------------------------------------------------------
Sub FixAllSheets()

    Dim sht                     As Worksheet            '// 処理中のワークシート
    Dim shtVisible                                      '// 表示可能なワークシート
    Dim iRow, iCol                                      '// 縦、横座標
    Dim sHiddenSheet                                    '// 非表示シート名
    Dim oFilterStatus           As AutoFilter           '// オートフィルタ状態
    Dim oRangeFilter            As Range                '// オートフィルタ設定

    For Each sht In Worksheets
        If (IsEmpty(shtVisible) = True) And (sht.Visible = xlSheetVisible) Then
            Set shtVisible = sht
        End If

        '// シートが表示されている場合
        If sht.Visible = xlSheetVisible Then
            Call FixCellPosition(sht)
        '// シートが非表示の場合
        Else
            sHiddenSheet = sHiddenSheet & "、" & sht.Name
            sht.Visible = xlSheetVisible
            Call FixCellPosition(sht)
            sht.Visible = xlSheetHidden
        End If
    Next

    shtVisible.Select

    If (sHiddenSheet <> "") Then
        MsgBox sHiddenSheet, vbOKOnly, "非表示シートあり"
    End If
End Sub

''' --------------------------------------------------------------------------------
''' <summary>
'''     現在のシートに対し、アクティブセルを「A1」に設定して表示倍率を100%とする。
''' </summary>
''' --------------------------------------------------------------------------------
Sub FixCellPosition(ByVal sht As Worksheet)
        sht.Select

        '// ウインドウ枠の固定がされている場合
        If ActiveWindow.FreezePanes = True Then
            iRow = ActiveWindow.SplitRow + 1
            iCol = ActiveWindow.SplitColumn + 1
            Cells(iRow + 1, iCol + 1).Activate
        End If

        Set oFilterStatus = sht.AutoFilter
        '// オートフィルタが設定されている場合
        If Not oFilterStatus Is Nothing Then
            '// フィルタが掛かっている場合
            If oFilterStatus.FilterMode = True Then
                '// フィルタが掛かっている行の先頭を選択
                Set oRangeFilter = Range("A1").CurrentRegion
                Set oRangeFilter = Application.Intersect(oRangeFilter, oRangeFilter.Offset(1, 0))
                Set oRangeFilter = oRangeFilter.SpecialCells(xlCellTypeVisible)
                Range("A" & CStr(oRangeFilter.Row)).Select
            End If
        End If

        sht.Range("A1").Select
        ActiveWindow.Zoom = 100

        ActiveCell.Activate         ' Excel97対策
        ' スクロール列の設定
        ActiveWindow.ScrollColumn = 1
        ' スクロール行の設定
        ActiveWindow.ScrollRow = 1
End Sub

参考情報