日報を自動作成しよう①


VBAを活用して、タイトルに当日の日付が入力された日報を自動作成するコードを紹介します。

今回のマクロでできること

上記のExcelで作られた日報を…

日付を入力した状態で、10ファイル自動生成します!!

VBAコード

早速VBAのコードをご紹介します。
細かい解説については次回以降させて頂きます。

Public DirPath As String
Public FolderPath As Variant

Sub マクロまとめ()
    If MsgBox("マクロを実行するファイルを選択してください", vbYesNo) = vbNo Then
    Exit Sub
    End If
    DirPath = Application.GetOpenFilename("Excelブック,*.xlsx;*.xls;*.xlsm")
    
    
        Call フォルダ作成
        Call フォーマットをコピーする
        Call セル内に日付と順番の入力
        
End Sub

Sub フォルダ作成()

    If MsgBox("保存先のフォルダを選択してください", vbYesNo) = vbNo Then
        Exit Sub
    End If
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' ユーザーにフォルダを選択してもらう
            FolderPath = .SelectedItems(1)
        Else ' ユーザーがキャンセルした場合はプログラムを終了する
            Exit Sub
        End If
    End With
    
    ' DirNameにオブジェクトを格納
    Set DirName = CreateObject("Scripting.FileSystemObject")
    
    ' 同じ日付のフォルダが存在しないか確認
    Dim NewFolderPath As String
    NewFolderPath = FolderPath & "\" & Format(Date, "yyyymmdd")
    If DirName.FolderExists(NewFolderPath) Then
        MsgBox "既に同じ日付のフォルダが存在します"
    Else
        MkDir NewFolderPath ' フォルダを作成
    End If
    
    ' DirNameをクリーンアップする
    Set DirName = Nothing
End Sub    

Sub フォーマットをコピーする()
    On Error GoTo err1
    
    Dim i As Long
    Dim A As String

        
        For i = 1 To 10
            If Dir(DirPath & Format(Date, "yyyymmdd") & _
                "\" & Format(Date, "yyyymmdd") & "_" & Format(i, "00") & ".xlsx") <> "" Then
                MsgBox "既に同名の受付簿が存在します"
                Exit Sub
            Else
                '下記にフォーマットの参照先を記載しているので、こちらを変更してください
                FileCopy (DirPath), (FolderPath & "\" & Format(Date, "yyyymmdd") & "\" & Format(Date, "yyyymmdd") & "_" & Format(i, "00") & ".xlsx")
            End If
        Next i
        Exit Sub

err1:
    If Err.Number = 53 Then
    MsgBox "受付簿フォーマットが変更されています"
    Else
    MsgBox "不明なエラーが発生しました"
    End If
End Sub

Sub セル内に日付と順番の入力()
        Dim i As Long
        
        For i = 1 To 10
            Workbooks.Open (FolderPath & "\" & Format(Date, "yyyymmdd") & "\" & Format(Date, "yyyymmdd") & "_" & Format(i, "00") & ".xlsx")
            Cells(7, 2) = Format(Date, "yyyy") & "/" & Format(Date, "mm") & "/" & Format(Date, "dd")
            ActiveWorkbook.Save
            ActiveWorkbook.Close
        Next i
        MsgBox "マクロが完了致しました"
        Exit Sub

End Sub

まとめ

いかかだったでしょうか。
上記のコードをVBAにコピペで動作するはずです。
細かいコードの解説を知りたい方は、ぜひ下記のリンクから続きをご覧ください。
それではお付き合いいただきありがとうございました。

日報を自動作成しよう②~フォルダを作成~


“日報を自動作成しよう①” への2件のフィードバック

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です