G-Tool2-Form-A01_WS比較用

ワークシートの比較ツール

Mainの【ワークシート比較ツール.xlsm】と、結果を書き込む【ワークシート比較結果雛形.xlsm】の
２つのブックを作成します。（Microsoft365 64bit環境推奨）

比較結果雛形ブックの作成

新規のExcelブック【ワークシート比較結果雛形.xlsm】を作成します。

新規ブックを作成します。
最初に、【ページレイアウト】タブをクリック
まず、左上の【テーマ】を【Office】に設定
次に、テーマの【フォント】→一番下の【フォントのカスタマイズ】をクリック
日本語の見出し、本文フォントを【Meiryo UI】に変更
最後に、【ホーム】タブ→【名前を付けて保存】
ブック名：ワークシート比較結果雛形.xlsm
【Excel マクロ有効ブック(*.xlsm)】で【保存】します。
※ 上記の設定をしない場合、後続の【Main】シート作成の操作を行った際に、列幅が正しく反映されません。

マクロコードの貼り付け

　作成された雛形ファイルに標準モジュールを追加します。

【Alt】＋【F11】キーを押下し、VBE画面を表示
【挿入】タブから【標準モジュール】を選択し、標準モジュールを作成
下記ボックス内をコピーし、標準モジュールに貼り付け
モジュール名を【A01_Public】に変更

　G-Tool2-Form-M01_WS比較用　につづく

　モジュール名：A01_Public

Option Explicit

Public Bln_Err As Boolean
Public Twb As Workbook
Public wsComp As Worksheet

Sub SetObject()
     Set Twb = ThisWorkbook
     Set wsComp = Twb.Worksheets("比較結果")
End Sub

Sub ReSetObject()
    Set Twb = Nothing
    Set wsComp = Nothing
End Sub

'*****************************************************
'    画面制御セット
'    Call StopUpdating
'*****************************************************
Sub StopUpdating()
    With Application
        .ScreenUpdating = False                 '画面描画停止
        .EnableEvents = False                   'イベント動作停止
        .EnableCancelKey = xlErrorHandler       '[Esc]キーでエラーをトラップする
        '=========================
        '.EnableCancelKey = xlInterrupt         '[Esc]キーでVBAの実行を止める（なかなか止まらない）
        '.EnableCancelKey = xlErrorHandler      '[Esc]キーでエラーをトラップする
                                                'On Error GoTo ★★★_Err と使用する
        '.EnableCancelKey ＝xlDisabled          '[Esc]キーを無効にする
        '=========================
        ' .Cursor = xlWait
        '計算設定取得
        Call yourCalc("比較結果", "R2")
        .DisplayAlerts = False                  '警告非表示
        .DisplayStatusBar = True                'ステータスバーを表示
    End With
End Sub

'*****************************************************
'    画面制御セット
'    Call Updating
'*****************************************************
Sub Updating()
        With Application
            .ScreenUpdating = True              '画面描画再開
            .EnableEvents = True                'イベント動作再開
            .Cursor = xlDefault
            .DisplayAlerts = True               '警告再表示
            '計算設定を戻す
            Call RestoreCalc("比較結果", "R2")
            .StatusBar = False
            'ステータスバーを表示
        End With
End Sub

'+++***********************************************+++
'    自動/手動計算設定取得
'    Call yourCalc("Main","A2")
'+++***********************************************+++
Public Function yourCalc(shtName As String, strRng As String)
    'エラーを無視
    On Error Resume Next

    With ThisWorkbook.Worksheets(shtName)
        With .Range(strRng)
            .Font.Color = .Interior.Color
            If Application.Calculation = xlCalculationAutomatic Then
                .Value = 1
            ElseIf Application.Calculation = xlCalculationManual Then
                .Value = 2
            ElseIf Application.Calculation = xlCalculationSemiautomatic Then
                .Value = 3
            End If
        End With
    End With
    
    'エラー制御を戻す
    On Error GoTo 0
    
End Function
'+++***********************************************+++
'    自動/手動計算を最初の設定に戻す
'    Call RestoreCalc("Main","A2")
'+++***********************************************+++
Public Function RestoreCalc(shtName As String, strRng As String)
    'エラーを無視
    On Error Resume Next
    
    With ThisWorkbook.Worksheets(shtName)
        With .Range(strRng)
            .Font.Color = .Interior.Color
            If .Value = 1 Then
                Application.Calculation = xlCalculationAutomatic
            ElseIf .Value = 2 Then
                Application.Calculation = xlCalculationManual
            ElseIf .Value = 3 Then
                Application.Calculation = xlCalculationSemiautomatic
            End If
        End With
    End With
    
    'エラー制御を戻す
    On Error GoTo 0
    
End Function
'-----------------------------------------------------
'   ステータスバーを使用する
'   Call showStatus(msg)
'-----------------------------------------------------
Public Sub showStatus(ByVal MSG As String)
    'エラーを無視
    On Error Resume Next
    ThisWorkbook.Activate
    ActiveWindow.WindowState = xlMaximized
    Application.StatusBar = MSG
    DoEvents
    'エラー制御を戻す
    On Error GoTo 0
End Sub
'-----------------------------------------------------
'   ステータスバーをClear
'   Call clrStatus
'-----------------------------------------------------
Public Sub clrStatus()
    'エラーを無視
    On Error Resume Next
    DoEvents
    Application.StatusBar = False
    'エラー制御を戻す
    On Error GoTo 0
End Sub
'-----------------------------------------------------
'   OSに制御を渡す
'   Call exeBreak
'-----------------------------------------------------
Public Sub exeBreak()
    'エラーを無視
    On Error Resume Next
    DoEvents
    'エラー制御を戻す
    On Error GoTo 0
End Sub

'+++***********************************************+++
'     シート検出
'     Call IsShtOwb(shtName, OtrwbName)
'+++***********************************************+++
Public Function IsShtOwb(shtName As String, wbName As  String) As Boolean
    Dim sht As Worksheet
    Dim Otrwb As Workbook
    
    IsShtOwb = False
    
    Set Otrwb = Workbooks(wbName)
    For Each sht In Otrwb.Worksheets
        If sht.Name = shtName Then
            IsShtOwb= True
            Set Otrwb = Nothing
            Exit Function
        End If
    Next sht
    
    'エラーを無視
    On Error Resume Next
    Set Otrwb = Nothing
    'エラー制御を戻す
    On Error GoTo 0
End Function

' +++*******************************************************+++
'    アクティブシートのシェイプを全削除
' +++*******************************************************+++
Public Sub delShapes()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next
End Sub