MyRibbonTools S01_OpenBook

Option Explicit

'+++*********************************************************+++
' SampleOpenBook：指定パスのブックを開く。
' ・「他ブックを開く」シートのB5セルにフルパスを記載。
' ・すでに開いている場合は再利用、異なるパスなら閉じる。
' ・開いたブックは FileBook に格納。
' ・入力チェック前の準備処理として使用。
'+++*********************************************************+++
Sub SampleOpenBook()

    '--------------------------------------------------
    '【初期宣言】ファイル情報・制御フラグ・エラーメッセージ
    '--------------------------------------------------
    Dim FileFullPath As String
    Dim FileName As String
    Dim FileBook As Workbook
    Dim wb As Workbook
    Dim IsOpen As Boolean
    Dim errMsg As String

    '--------------------------------------------------
    '【ファイル情報取得】B5セルからパスを取得・整形
    '--------------------------------------------------
    With ThisWorkbook.Worksheets("他ブックを開く")
        FileFullPath = .Range("B5").Value
        FileFullPath = Replace(FileFullPath, "/", "\")
        FileName = Mid(FileFullPath, InStrRev(FileFullPath, "\") + 1)
    End With

    '--------------------------------------------------
    '【ブック確認】既に開いているかチェック
    '--------------------------------------------------
    IsOpen = False
    For Each wb In Workbooks
        If LCase(wb.Name) = LCase(FileName) Then
            If wb.FullName = FileFullPath Then
                IsOpen = True
                Set FileBook = wb
                Exit For
            Else
                wb.Close
            End If
        End If
    Next wb

    '--------------------------------------------------
    '【ブックを開く】未開の場合のみ ReadOnly で開く
    '--------------------------------------------------
    If IsOpen = False Then
        Set FileBook = Workbooks.Open(FileName:=FileFullPath, _
                                      ReadOnly:=True, UpdateLinks:=0)
    End If

    '--------------------------------------------------
    '【ステータス表示】次処理への準備
    '--------------------------------------------------
    Call showStatus("入力チェック中")
    errMsg = ""

SampleOpenBook_Exit:

    '一時的にエラー無視
    On Error Resume Next
    Call ReSetObject
    Call Updating

    'エラーハンドリング解除
    On Error GoTo 0
    Exit Sub

SampleOpenBook_Err:

    '--------------------------------------------------
    '【エラー処理】実行時エラーの表示と終了
    '--------------------------------------------------
    MsgBox "実行時エラー:" & Err.Number & vbCr & _
           Err.Description & vbCr & _
           "処理を終了します。", vbExclamation, myProcd
    Err.Clear

    'エラーハンドリング解除
    On Error GoTo 0
    Exit Sub

InputCheck_Err:

    '--------------------------------------------------
    '【入力チェックエラー】メッセージ表示と終了
    '--------------------------------------------------
    If errMsg <> "" Then
        MsgBox errMsg & vbCr & _
               "処理を終了します。", vbExclamation, "入力エラー"
        Err.Clear
        GoTo SampleOpenBook_Exit
    End If

End Sub