Template_M05_OpenBook

他のブックを開く際のコード例
(Microsoft365 64bit環境推奨)

 G-Tool1-A01 からのつづき
 6.【Alt】+【F11】キーを押下し、VBE画面を出す。
 7.【挿入】タブから【標準モジュール】を選択し、標準モジュールを作成。
 8.下記ボックス内をコピーし、標準モジュールに貼り付ける。
 9.モジュール名を【M05_OpenBook】に変更する。

 モジュール名:M05_OpenBook
Option Explicit

'+++*****************************************************+++
'    他ブックを開くサンプルコード
'+++*****************************************************+++
Sub SampleOpenBook()
    
    Dim FileFullPath As String
    Dim FileName As String
    Dim FileBook As Workbook
    Dim wb As Workbook
    Dim IsOpen As Boolean
    
    With ThisWorkbook.Worksheets("他ブックを開く")
        FileFullPath = .Range("B5").Value
        FileFullPath = Replace(FileFullPath, "/", "\")
        FileName = Mid(FileFullPath, InStrRev(FileFullPath, "\") + 1)
    End With
    
    '作業中のPCで開いているかどうか
    '開かれているファイルかどうか確認
    IsOpen = False
    For Each wb In Workbooks
        '対象ファイルと同名のファイルが開かれている
        If wb.Name = FileName Then
            '対象ファイルそのものの場合
            If wb.FullName = FileFullPath Then
                IsOpen = True
                Set FileBook = wb
                Exit For
            '対象ファイルそのものではない場合
            Else
        '同名ファイルは保存せず閉じる
                wb.Close
            End If
        End If
    Next wb
    
    '【比較ファイル①】のシートを【比較結果】ファイルにコピー
    '読み取り、リンク更新なしで開く
    If IsOpen = False Then
        Set FileBook = Workbooks.Open(FileName:=FileFullPath, _
                                ReadOnly:=True, UpdateLinks:=0)
    End If

'====================================================
'    入力チェック
'====================================================
    'ステータスバーに状況表示
    Call showStatus("入力チェック中")
    '空白、存在チェック
    errMsg = ""    '初期If format
'~~~
'~~~

SampleOpenBook_Exit:
    
    'エラーを無視
    On Error Resume Next

    Call ReSetObject
    Call Updating
    
    'エラー制御を戻す
    On Error GoTo 0
    Exit Sub
    
SampleOpenBook_Err:

    Bln_Err = True
    MsgBox "実行時エラー:" & Err.Nuer & "" & _
        Err.Description & vbCr & _
        "処理を終了します。", vbExclamation, ErrProsName
    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

コメント

タイトルとURLをコピーしました