この続きですので、こちらからご覧ください
指定のブックがあれば、そのブックを開き、なければブックを作成する
指定したブックがあるかどうか？確認しましょう！
ファイル構成
ファイル構成を旧システムから新システムへ以下の様に変更します
旧システム（シートの追加）
プログラムもデータもすべて同じブックに保存される 来年のデータはどうする？
新システム（ブックの追加）
年度別に家計簿を作成します
実行ファイルとデータファイルを分けます
売上管理・請求書・工程表など年度別月別シートを作成する処理に応用してください
実行ファイル(プログラムファイル)
ファイル選択(ｼｰﾄ)：年月を指定するシート
家計簿ひな型(ｼｰﾄ)：作成シートのひな型
項目マスタ―(ｼｰﾄ)：マスタデータ
データフォルダ
年度別ファイル：シート 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は同じ ブックが１つしかないので
新システムでは、初めはThisWorkBookとActiveWorkBookは同じ、
家計簿ファイルが作成された時、このファイルがActiveWorkBookとなる
ThisWorkBook ：マクロを実行しているブック どのような環境であっても指定可
ActiveWorkBook ：現在表示しているワークブック(最後に開いたブック 必ず１つ)
ブックを開くたびに変更される
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 & "\データ２\家計簿" & 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 家計簿作成シート追加２どちらかを選択する
ブックの追加で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 家計簿作成シート追加２(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) '１ Or ２
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) '１ Or ２
Call 家計簿作成シート追加2(Nen, Tuki) 'どちらか選ぶ
End Subシートの追加１or２どちらか好きな方で実行してください
YouTubeでは、２を選択しています
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 SubSub 家計簿作成シート追加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 SubSub 家計簿作成シート追加2(Nen As Long, Tuki As Long)
Dim Tuki_Name As String '作成する月のシート名("1月"等)
Dim WS As Worksheet 'ワークシートを表す変数
Tuki_Name = Tuki & "月" '作成する家計簿の月のシート名
'指定した月のシートがあるかどうか Part２
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 SubSub 終了()
Application.DisplayAlerts = False '確認メッセージを表示させない
If Workbooks.Count <= 1 Then '他のブックが開いていなければ
Application.Quit 'Excelを終了する
End If
End Sub
コメント