ブックの追加

YouTube VBA

  この続きですので、こちらからご覧ください

指定のブックがあれば、そのブックを開き、なければブックを作成する
指定したブックがあるかどうか?確認しましょう!

ファイル構成

ファイル構成旧システムから新システムへ以下の様に変更します

旧システム(シートの追加)

プログラムもデータもすべて同じブックに保存される 来年のデータはどうする?

新システム(ブックの追加)

年度別に家計簿を作成します
実行ファイルとデータファイルを分けます
売上管理・請求書・工程表など年度別月別シートを作成する処理に応用してください

実行ファイル(プログラムファイル)
ファイル選択(シート):年月を指定するシート
家計簿ひな型(シート):作成シートのひな型
項目マスタ―(シート):マスタデータ

データフォルダ
年度別ファイル:シート 1~12月
項目マスタ―(シート):マスタデータ

プログラムファイルの構成

ファイル選択シート

年月の指定
年・月ファイル選択シートで入力します

Sub 家計簿作成ブック追加()
Dim Nen As Long               ’作成する家計簿の年
Dim Tuki As Long               ‘作成する家計簿の月
Dim Tuki_Name As String            ’作成する月のシート名

Nen = Worksheets(“ファイル選択”).Range(“d5”)
Tuki = Worksheets(“ファイル選択”).Range(“d7”)
Tuki_Name = Tuki & “月”            ’作成する月のシート名(“1月”等)

ブック作成するために必要な知識

パスとカレント

パスとは…
C¥家計簿作成¥データ¥家計簿xxxx年.xlsx の様に、
ファイルやフォルダーが コンピューター上のどこにあるかを示す住所のこと
(ルートディレクトリからのすべての道のりを示したものをフルパスという)

カレントフォルダとは…
自分が今いるディレクトリのこと
家計簿xxxx年.xlsx とファイル名だけ指定すれば、今いるフォルダにあるファイルが参照される

フルパス個々の環境で異なるので、
フルパスを指定して
マクロを実行することはできない!

ThisWorkBook・ActiveWorkBook・ThisWorkbook.Path

旧システムでは、ThisWorkBookとActiveWorkBookは同じ ブックが1つしかないので

新システムでは、初めはThisWorkBookとActiveWorkBookは同じ、
家計簿ファイルが作成された時、このファイルがActiveWorkBookとなる

ThisWorkBook   :マクロを実行しているブック どのような環境であっても指定可
ActiveWorkBook  :現在表示しているワークブック(最後に開いたブック 必ず1つ)
            ブックを開くたびに変更される
ThisWorkbook.Pathマクロを書いているブック(ThisWorkBook)のフォルダ

ブックがどこにあるか?どのフォルダーに作るか?

データの指定方法
ThisWorkbook.Path¥データフォルダー¥家計簿xxxx年.xlsx

Dir関数

ファイルがあるかどうか確認する

例)If Dir(FileName) <> “” Then

ブックの作成

シートをCopy→新規ブックを作成する方法

動画ではこの方法で紹介しています

ファイルが存在する
Dir関数の戻り値<>NULL戻り値のファイルをOpen

ファイルが存在しない
Dir関数の戻り値=NULL①シートCopy→新規ブック作成(項目項目マスターシート→Book1)
             ②作成したブックに名前を付けて保存(Book1→家計簿xxxx年.xlsx)

    FileName = ThisWorkbook.Path & "\データ\家計簿" & Nen & "年.xlsx"
    
    If Dir(FileName) <> "" Then     'ファイルがあるかどうか確認する
    
        Workbooks.Open FileName     'ファイルがある時
        
    Else
                      'ファイルがない時

        Worksheets("項目マスタ").Copy      '項目マスタシートCopy→ファイル作成
        ActiveWorkbook.SaveAs FileName    '新しいブックとして名前を付けて保存
        
    End If

訂正
ThisWorkbook.Worksheets(“項目マスタ”).Copy

動画では、項目マスターシートはプログラムファイルにあるので、
ThisWorkbookが必要としていますが、
項目マスタをCopyする時点では、プログラムファイルがカレントなので、
ThisWorkbook.はなくてもいいです m(__)m

Workbooks.Addメソッドで追加する方法

FileName = ThisWorkbook.Path & "\データ2\家計簿" & Nen & "年.xlsx"
    
    If Dir(FileName) <> "" Then     'ファイルがあるかどうか確認する
    
        Workbooks.Open FileName     'ファイルがある時
        
    Else
            
                        'ファイルがない時
        Workbooks.Add                                   '新しいブック作成
        ActiveWorkbook.SaveAs FileName                  '作成したブックに名前を付けて保存
        
            
    End If

どちらの方法も
Worksheets(“項目マスタ”).Copy Or Workbooks.Add した瞬間に
作成したブックにActiveWorkbookが変更する

シートの追加

前回のシートの追加に続く
作成したSub 家計簿作成シート追加1 Or Sub 家計簿作成シート追加2どちらかを選択する

ブックの追加でActiveWorkbookは、家計簿ファイルに変更されている
家計簿ひな形は、ThisWorkbookにあるので、ThisWorkbookを指定する必要がある

その他、ブックの指定のないシート、セルは、ActiveWorkbookを参照している

ThisWorkbook.Worksheets(“家計簿ひな形”).Copy after:=Worksheets(Worksheets.Count)

このWorksheetsは、ActiveWorkbookのシート     

'家計簿ひな形シートを末尾にコピー
ThisWorkbook.Worksheets("家計簿ひな形").Copy after:=Worksheets(Worksheets.Count)

'ワークシート名を指定月に!
Worksheets(Worksheets.Count).Name = Tuki_Name

ファイルの保存

終了する前に、記入した内容を保存する必要がある
家計簿シートにボタンを作成し、終了処理を呼び出す

変更があれば、保存して閉じる
Workbooks(Filename).Close savechanges:=Trueを選択


Workbooks(Filename)は、ActiveWorkbookとすれば、

Filenameを引数にしないで済む(どのファイルと指定する必要がない)

Sub ファイル選択に戻る()

    ActiveWorkbook.Close savechanges:=True            '変更があれば、保存して閉じる
    ThisWorkbook.Worksheets("ファイル選択").Activate   'ファイル選択シートをアクティブに!
    
End Sub

サブルーチン化

ブックの追加シートの追加サブルーチンとし、
メインプログラムから呼び出す

メインプログラムでNen,Tukiを宣言
サブルーチンの引数とする

Call 家計簿作成ブック追加(Nen)

Call 家計簿作成シート追加1(Nen, Tuki)
Call 家計簿作成シート追加2(Nen, Tuki)

どちらか

                ブック追加

                シート追加

Sub 家計簿作成()
    
    Dim Nen As Long                 '作成する家計簿の年
    Dim Tuki As Long                '作成する家計簿の月
    
    Nen = Worksheets("ファイル選択").Range("d5")
    Tuki = Worksheets("ファイル選択").Range("d7")
     
    Call 家計簿作成ブック追加(Nen)
    
    'Call 家計簿作成シート追加1(Nen, Tuki) '1 Or 2
    Call 家計簿作成シート追加2(Nen, Tuki)    'どちらか選ぶ

End Sub

実行ボタンの作成

作成ボタン

家計簿作成プロシージャと紐づける

家計簿ひな型シート
ファイル選択へボタン

ファイル選択に戻るプロシージャと紐づける
終了処理、ファイルを保存し
ファイル選択シートに戻る

Sub ファイル選択に戻る()

    ActiveWorkbook.Close savechanges:=True            '変更があれば、保存して閉じる
    ThisWorkbook.Worksheets("ファイル選択").Activate  'ファイル選択シートをアクティブに!
    
End Sub

終了ボタン

終了プロシージャと紐づける
Excelを終了する

Sub 終了()
    
    Application.DisplayAlerts = False              '確認メッセージを表示させない
    
    If Workbooks.Count <= 1 Then                   '他のブックが開いていなければ
        
        Application.Quit                           'Excelを終了する
        
    End If
    
End Sub

ソースコード

Sub 家計簿作成()
    
    Dim Nen As Long                 '作成する家計簿の年
    Dim Tuki As Long                '作成する家計簿の月
    
    Nen = Worksheets("ファイル選択").Range("d5")
    Tuki = Worksheets("ファイル選択").Range("d7")
     
    Call 家計簿作成ブック追加(Nen)
    
    'Call 家計簿作成シート追加1(Nen, Tuki) '1 Or 2
    Call 家計簿作成シート追加2(Nen, Tuki)    'どちらか選ぶ

End Sub

シートの追加1or2どちらか好きな方で実行してください
YouTubeでは、2を選択しています

Sub 家計簿作成ブック追加(Nen As Long)

    Dim FileName As String          '作成ファイル名
        
    
    FileName = ThisWorkbook.Path & "\データ\家計簿" & Nen & "年.xlsx"
    
    If Dir(FileName) <> "" Then     'ファイルがあるかどうか確認する
    
        Workbooks.Open FileName     'ファイルがある時
        
    Else
    
        ThisWorkbook.Worksheets("項目マスタ").Copy      '項目マスタシートCopy→ファイル作成
        ActiveWorkbook.SaveAs FileName                  '新しいブックとして名前を付けて保存
        
    End If
       
End Sub
Sub 家計簿作成シート追加1(Nen As Long, Tuki As Long)

    Dim Tuki_Name As String         '作成する月のシート名("1月"等)
    Dim WS As Worksheet             'ワークシートを表す変数
    Dim SW As Long                  'スイッチ(ワークシートがあるか?の判断に使う)
    
    Tuki_Name = Tuki & "月"         '作成する家計簿の月のシート名
    
    '指定した月のシートがあるかどうか Part1
    
    SW = 0                          'スイッチの初期値

    For Each WS In Worksheets       'ワークシートの数だけループ

        '取り出したワークシートの名前がTuki_Nameの時
        If WS.Name = Tuki_Name Then SW = 1

    Next WS                         'For Eachの終わり

    If SW = 0 Then                  'ワークシートがない時
                                    '家計簿ひな形シートを末尾にコピー
        ThisWorkbook.Worksheets("家計簿ひな形").Copy after:=Worksheets(Worksheets.Count)
                                    'ワークシート名を指定月に!
        Worksheets(Worksheets.Count).Name = Tuki_Name
        Range("m1") = Nen
        Range("h1") = Tuki

    Else                            'ワークシートがある時

        Worksheets(Tuki_Name).Activate '指定月のシートをアクティブに!

    End If
    
End Sub
Sub 家計簿作成シート追加2(Nen As Long, Tuki As Long)

    Dim Tuki_Name As String         '作成する月のシート名("1月"等)
    Dim WS As Worksheet             'ワークシートを表す変数
    
    Tuki_Name = Tuki & "月"         '作成する家計簿の月のシート名
  
    '指定した月のシートがあるかどうか Part2
    
    On Error Resume Next            'エラーが発生しても、次に進む

    Set WS = Worksheets(Tuki_Name)  'シート名をワークシート型変数に代入

    If WS Is Nothing Then           'WSがNothingの時(シートがない時)

                                    '家計簿ひな形シートを末尾にコピー
        ThisWorkbook.Worksheets("家計簿ひな形").Copy after:=Worksheets(Worksheets.Count)
                                    'ワークシート名を指定月に!
        Worksheets(Worksheets.Count).Name = Tuki_Name
        Worksheets(Tuki_Name).Range("m1") = Nen
        Worksheets(Tuki_Name).Range("h1") = Tuki

    Else                            'ワークシートがある時

        Worksheets(Tuki_Name).Activate '指定月のシートをアクティブに!

    End If

    On Error GoTo 0                     '通常のエラー処理に戻す

End Sub
Sub ファイル選択に戻る()

    ActiveWorkbook.Close savechanges:=True            '変更があれば、保存して閉じる
    ThisWorkbook.Worksheets("ファイル選択").Activate  'ファイル選択シートをアクティブに!
    
End Sub
Sub 終了()
    
    Application.DisplayAlerts = False                 '確認メッセージを表示させない
    
    If Workbooks.Count <= 1 Then                      '他のブックが開いていなければ
        
        Application.Quit                              'Excelを終了する
        
    End If
    
End Sub

コメント