アプリケーションとしてのVBA Excel(エクセル) VBA の役立つ Tips の紹介

アプリケーションとしてのVBA

ブックを開く



ブックを開く


  ブックを開いてみましょう。
  
  ファイルのパスを取得する「GetFilePath」または「GetFilePath2」に1行追加するだけ
  です。
  
  Open_Target_File FileNamePath, Open_Workbook_Name
  
  簡単ですね。

  FileNamePath は取得したファイルのパスですが、Open_Workbook_Name は開いたブックの
  名前が格納されて返って来ます。
  
  ブックを開いたからには、閉じたり、前面に出したりする必要が出てくると思います。
  
  そんな時に、
  
  Workbooks(Open_Workbook_Name).Close
  
  見たいに使うためです。
  
  Open_Target_File では、既に開いてあった場合ブックを前面に出すようにしてあります。
  
  Workbooks.Open メソッドは、既に開いてあるとエラーになります。
  
  「あっ 開いてあるブックを選択してしまった !」とならないようにです。
  
  
  
Sub OpenWorkbook()

    Dim Open_Workbook_Name                          As String
    Dim FileNamePath                                As Variant
    Dim File種類                                    As String
    Dim Prompt                                      As String
    
    File種類 = "Excelファイル,*.xls;*.xlsx;*.xlsm"
    Prompt = "開きたいExcelのファイルを選択してください"
    FileNamePath = SelectFileNamePath(File種類, Prompt)
    
    If FileNamePath = False Then
        'キャンセルボタンが押された
        Exit Sub
    End If

    Open_Target_File FileNamePath, Open_Workbook_Name

End Sub


Sub Open_Target_File(FileNamePath, Open_Workbook_Name)

    Dim Open_Workbook                   As Workbook
    Dim FileSystemOBJ                   As Object
    Dim ReadyOpen                       As Boolean
    
    Set FileSystemOBJ = CreateObject("Scripting.FileSystemObject")
    
    ReadyOpen = False
    'すでに開いてあるか確認
    For Each Open_Workbook In Workbooks

        If Open_Workbook.Name = FileSystemOBJ.GetFileName(FileNamePath) Then
            Open_Workbook_Name = Open_Workbook.Name
            ReadyOpen = True
        End If
    Next

    If ReadyOpen = False Then
        If Dir(FileNamePath) = FileSystemOBJ.GetFileName(FileNamePath) Then
            
            Workbooks.Open Filename:=FileNamePath
            
            Open_Workbook_Name = ActiveWorkbook.Name
        
        Else
            MsgBox "選択したパス" & vbCrLf & FileNamePath & " が存在しません。" _
            & vbCrLf & "パスを正しく設定してください"
            End
        End If
    End If

    Set FileSystemOBJ = Nothing

    Windows(Open_Workbook_Name).Activate

End Sub


  StartKitsParts.xls をダウンロードして、ご使用ください。




Copy (C) 2005   アプリケーションとしてのVBA   All Rights Reserved.