ＥｘｃｅｌＶＢＡ 応用編 ブックとシート

「ExceｌVBA入門」を応用したサンプルプロシージャです。
このサンプルプロシージャは、私の環境で作成したものです。このままコードをコピーしても実行させることはできません。 お使いになる場合は、自分の環境に合わせて作成しなおしてください。

★ブックの有無を調べるには

ブックの有無を調べるには Dir関数を使います。

Sub ブックの有無を調べる()


   Dim myBook As String
   
   myBook = Dir("c:\MyData\ExcelData\納品書.xls")
   MsgBox myBook
   

End Sub

★アクティブブックのパスを求めるには

アクティブブックのパスを求めるには、ThisWorkbookプロパティを使います。 
Sub パスを調べる()

   'アクティブブックのパスを調べる
   
   Dim myPath As String
   
   myPath = ThisWorkbook.Path
   MsgBox myPath
   
End Sub

★ブックを開く

ブックが存在してるかを調べて、存在していたら開きます。 
Sub ブックを開く()

   Dim myBook As String
   
   'ブック名をパスつきで変数に代入
   myBook = ThisWorkbook.Path & "\" & "納品書.xls"
   
   'もしも指定のファイルがなかったプロシージャを終える
   If Dir(myBook) = "" Then
      MsgBox "納品書.xsl がありません"
      Exit Sub
   End If
  
   'ワークブックを開く
   Workbooks.Open myBook

End Sub

★ブックが開かれているか調べる

このプロシージャでは指定のブックが開かれているかを調べます。
Sub ブックが開かれているか調べる()
    
    Dim myBook As Workbook, flag As Boolean
    
    'For Each ステートメント内では Workbooks コレクションのメンバーが順番に登場します。
    'そこで、myBook.Name が「納品書.xls」かどうかを判定します。

    For Each myBook In Workbooks
        If myBook.Name = "納品書.xls" Then flag = True
    Next myBook
    
    
    If flag = True Then
        MsgBox "納品書は開いています", vbInformation
    Else
        MsgBox "納品書は開いていません", vbInformation
    End If
End Sub

★ワークシートをコピーする

  1. 次のプロシージャは、納品書フォームをコピーし「作業用納品書」を作成します。
  2. コピーした納品書には、納品日付でシート名をつけます。
  3. 同名のシートがあるときには、処理を中断します。
  4. このプロシージャを実行するには「納品書作成｣ブックが必要です 
Sub 納品書作成()

  
  '変数を宣言する
  Dim myYear, myMonth, myDay As Integer
  Dim sheetName As String
  Dim sheetCount As Integer
  Dim i As Integer
  
  '年月日(メニューシート）を変数に代入する
  With Worksheets("メニュー")
        myYear = .Range("B3").Value
        myMonth = .Range("C3").Value
        myDay = .Range("D3").Value
  End With
  
  '新しいシート名を変数に格納する
  'シート名には年月日をつけるものとする
  sheetName = myYear & "-" & Format(myMonth, "00") _
      & "-" & Format(myDay, "00")
  sheetCount = Worksheets.Count
  
  'エラー処理
  '同じ名前のシートを見つけたら処理を中断する
  For i = 3 To sheetCount
     If sheetName = Worksheets(i).Name Then
        MsgBox "同じ名前のシートがあります"
        Worksheets(i).Activate
        Exit Sub
     End If
  Next
  
  '納品書フォームシートを末尾にコピーします。
  Worksheets("納品書フォーム").Copy After:=Worksheets(sheetCount)
  'コピーしたシートに名前をつけます。
  With Worksheets(sheetCount + 1)
     .Name = sheetName
     .Range("F4").Value = myYear & "年" & myMonth & "月" & myDay & "日"
  End With
 
End Sub