New-A01

Option Explicit

''参照設定: Dictionary用& FSO
''Microsoft Scripting Runtime
''参照設定: 正規表現
''Microsoft VBScript Regular Expressions 5.5
''参照設定: PPT用
''Microsoft PowerPoint 16. 0 ObjectLibrary
''VBE出力用
''Microsoft Visual Basic for Applications Extensibility 5.3

    Public IsCall As Boolean
    Public BlnCall As Boolean
    Public myProcd As String
    Public errMsg As String
'********************************************
'    定数定義（記録・復元を使うかどうか）
'   【Main】シートありの場合で、
'  　手動計算でマクロ実行するかどうか
'********************************************
    Const USE_CALC_RESTORE As Boolean = False
    
    Public Twb As Workbook
    Public wsMain As Worksheet
    Public wsCtrl As Worksheet
'    Public wsCtrl1 As Worksheet
'    Public wsData As Worksheet
'    Public wsWork As Worksheet
'    Public wsResult As Worksheet

Sub SetObject()
    Set Twb = ThisWorkbook
    Set wsMain = Twb.Worksheets("Main")
    Set wsCtrl = Twb.Worksheets("Ctrl")
'    Set wsCtrl1 = Twb.Worksheets("Ctrl1")
'    Set wsData = Twb.Worksheets("Data")
'    Set wsWork = Twb.Worksheets("Work")
'    Set wsResult = Twb.Worksheets("Result")
End Sub

Sub ReSetObject()
    Set Twb = Nothing
    Set wsMain = Nothing
    Set wsCtrl = Nothing
    Set wsCtrl1 = Nothing
'    Set wsData = Nothing
'    Set wsWork = Nothing
'    Set wsResult = Nothing
End Sub

'*****************************************************
'    画面制御セット
'    Call StopUpdating
'*****************************************************
Sub StopUpdating()
    With Application
        If USE_CALC_RESTORE Then
            '現在の計算モードを記録 (1 = 自動､0 = 手動)
            If .Calculation = xlCalculationAutomatic Then
                ThisWorkbook.Sheets("Ctrl").Range("A2").Value = 1
                .Calculation = xlCalculationManual            '計算を手動に設定
            Else
                ThisWorkbook.Sheets("Ctrl").Range("A2").Value = 0
            End If
        End If

        .ScreenUpdating = False                     '画面描画停止
        .EnableEvents = False                       'イベント動作停止
        .EnableCancelKey = xlInterrupt              '[Esc]キーでVBAの実行を止める
        '=========================
        '.EnableCancelKey = xlInterrupt             '[Esc]キーでVBAの実行を止める（実際は、まず止まらない）
        '.EnableCancelKey = xlErrorHandler          '[Esc]キーでエラーをトラップする
                                                    'On Error GoTo ★★★_Err と使用する
        '.EnableCancelKey ＝xlDisabled              '[Esc]キーを無効にする
        '=========================
        .Cursor = xlWait                            'ウエイトカーソル
        .DisplayAlerts = False                      '警告非表示
        .DisplayStatusBar = True                    'ステータスバーを表示
    End With
    
    
End Sub

'*****************************************************
'    画面制御セット
'    Call Updating
'*****************************************************
Sub Updating()
    Dim calcMode As Variant
    With Application
        .ScreenUpdating = True                   '画面描画再開
        .EnableEvents = True                     'イベント動作再開
        .Cursor = xlDefault
        '.Calculation = xlCalculationAutomatic   '計算を自動に設定　'場合によって
        .DisplayAlerts = True                    '警告再表示
        .StatusBar = False                       'ステータスバーの表示した文字を消す
        
        If USE_CALC_RESTORE Then
            '記録された計算モードを復元
            calcMode = ThisWorkbook.Sheets("Ctrl").Range("A2").Value
            If calcMode = 1 Then
                .Calculation = xlCalculationAutomatic
            Else
                .Calculation = xlCalculationManual
            End If
        End If
    End With
End Sub

'-----------------------------------------------------
'   ステータスバーを使用する
'   Call showStatus(msg)
'-----------------------------------------------------
Public Sub showStatus(ByVal msg As String)

    '一時的にエラー無視
    On Error Resume Next
    DoEvents
    Application.StatusBar = msg
    'エラーハンドリング解除
    On Error GoTo 0
End Sub
'-----------------------------------------------------
'   ステータスバーをClear
'   Call ClearStatus
'-----------------------------------------------------
Public Sub ClearStatus()

    '一時的にエラー無視
    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
'-----------------------------------------------------
'   Sleepの代わりに0.5秒待つ処理
'   Call WaitHalfSecond
'-----------------------------------------------------
Public Sub WaitHalfSecond()
    Dim waitTime As Double
    waitTime = Timer + 0.5
    Do While Timer < waitTime
        '一時的にエラー無視
        On Error Resume Next
        DoEvents
        'エラーハンドリング解除
        On Error GoTo 0
    Loop
End Sub
'-----------------------------------------------------
'   Sleepの代わりに1秒待つ処理
'   Call WaitOneSecond
'-----------------------------------------------------
Public Sub WaitOneSecond()
    Dim waitTime As Double
    waitTime = Timer + 1
    Do While Timer < waitTime
        '一時的にエラー無視
        On Error Resume Next
        DoEvents
        'エラーハンドリング解除
        On Error GoTo 0
    Loop
End Sub