新しいExcelのファイルを作成する
新しいExcelのファイルを作成するプログラムを書いてみました。新しいExcelファイルを作成する上で事前に決めておくことは、ファイルをどこのフォルダに作成するかということです。そこで、ファイルパスをセルに入力するようにします。
A2セルにファイルパスを入力するようにしました。まず、入力されたパスが正しいか確認をします。(空白でないか、フォルダは存在するか)このとき、フォルダパスは入力されておらず、ファイル名のみ入力されることも考えてみました。もし、フォルダパスが入力されていない場合、実行ファイル(プログラムが存在するファイル)と同一のフォルダにファイルを作成することとします。プログラムとしては、ファイルパスを取得し、チェックした後、ファイルパスを戻り値で返すようにしました。
Private Function getFileName() 'プログラム実行ファイルがアクティブになっていない可能性もあるため、実行ブックをアクティブにする ThisWorkbook.Activate 'A2セルの文字列を取得 Dim fPath As String fPath = Cells(2, "A").Value 'A2セルの文字列が空白の場合 If fPath = "" Then MsgBox "ファイル名を入力してください" Exit Function End If 'A2セルの文字列の末尾が「.xls」じゃなかったら、付加する If Right(fPath, 4) <> ".xls" Then fPath = fPath & ".xls" End If 'ファイル名の中に「\」が存在する場合 If InStr(fPath, "\") Then 'フォルダパス取得 '(最後の「\」の文字まで切り取る) Dim folPath As String folPath = Left(fPath, InStrRev(fPath, "\")) 'フォルダが存在するかチェック If Dir(folPath, vbDirectory) = "" Then MsgBox "フォルダが存在しません。" End If Else '実行ファイルのフォルダを親フォルダに設定 fPath = ThisWorkbook.Path & "\" & fPath End If getFileName = fPath 'ファイル名をかえす End Function
次にファイル作成処理です。ファイル作成はワークブックコレクション(開いているワークブックの集まり)にワークブックを追加します。追加したワークブックを名前をつけて保存するようにします。最後に保存したワークブックを閉じます。保存する際、同名のファイル名が存在した場合、上書き確認のメッセージがでます。今回は、新規で作成する場合を想定しているため、始めに同名のファイルが存在する場合はエラーで抜けるようにしました。
Public Sub CreateExcelFile() 'A2セルのファイル名取得 Dim fPath As String fPath = getFileName '同名のファイルが存在するか確認 If Dir(fPath, vbNormal) <> "" Then MsgBox "同名のファイルが存在します。" Exit Sub End If 'ワークブックの追加 Workbooks.Add 'アクティブワークブックをファイル名を指定して保存 ActiveWorkbook.SaveAs (fPath) 'アクティブワークブックを閉じる ActiveWorkbook.Close End Sub