VBA : 一ヶ月の予定リストの作成して、csv を読み込んでデータを表示する

概要

"対象" という名前のシートがあればそれを使い、無ければ "テンプレート" シートをコピーして、"対象" と言う名前に変更します。そのシートに対して、指定した年月の 1日から 末日までの年月表示を縦に作成し、その横に曜日を表示します。

この後、ファイル参照ダイアログで csv データを選択し、csv の 最初と２番目の列のデータを各日付用データとして表示します。

▼ ここからボタンをクリックすると


▼ こんな感じになります


ボタンの追加は、フォーム コントロールでは無く、ActiveX コントロールを使用しています。こうする事によって、イベントがこのシートの中に作成されて管理がしやすいですし、デザインモードで切り替えて編集するので、通常時はすぐ実行できます。( フォームコントロールでは、モジュール内にイベントが作成され、『マクロの登録』という悲しい処理をしなくてはいけません )

※ デザインモードでは、コントロールを選択すると『=EMBED("Forms.CommandButton.1","")』と表示されます

対象月は、データの入力規則を使用してコンボボックス形式で選択するようにしています。

VBA 実行部分のソースコード

Private Sub CommandButton1_Click()

    ' データ処理をする Sheet
    Dim sheet As Worksheet
    
    ' "対象" Sheet の取得
    On Error Resume Next
    Set sheet = Worksheets("対象")
    On Error GoTo 0
    
    ' "対象" Sheet が無い場合は テンプレート をコピーして作成
    If sheet Is Nothing Then
        Call Worksheets("テンプレート").Copy(, Worksheets("年月入力"))
        ' コピーした Sheet の名前を変更
        Application.ActiveSheet.Name = "対象"
        ' 変数にコピーした Sheet をセット
        Set sheet = Application.ActiveSheet
    End If
    
    ' 曜日文字列の用意
    Dim Youbi(8) As String
    Youbi(1) = "日曜"
    Youbi(2) = "月曜"
    Youbi(3) = "火曜"
    Youbi(4) = "水曜"
    Youbi(5) = "木曜"
    Youbi(6) = "金曜"
    Youbi(7) = "土曜"

    Dim dtValue As Date
    Dim startDate As Date
    Dim endDate As Date
    
    ' 入力値から日付データの作成
    Dim s1 As String
    Dim s2 As String
    s1 = CStr(Worksheets("年月入力").Cells(2, 1).Value)
    s2 = CStr(Worksheets("年月入力").Cells(2, 2).Value)
    dtValue = CDate(s1 & "/" & s2 & "/1")
    
    ' 月のはじめ
    startDate = DateSerial(Year(dtValue), Month(dtValue), 1)
    ' 月末
    endDate = DateSerial(Year(dtValue), Month(dtValue) + 1, 0)
    
    ' ひと月ぶんの初期化
    For I = 1 To 31
        
        sheet.Cells(I + 1, 1).Value = ""
        sheet.Cells(I + 1, 2).Value = ""
        
    Next
    
    ' ひと月ぶんのデータの作成
    Dim row As Integer: row = 0
    For dtValue = startDate To endDate

        row = row + 1
        sheet.Cells(row + 1, 1).Value = CStr(dtValue)
        sheet.Cells(row + 1, 2).Value = Youbi(Weekday(dtValue))

    Next

    Call sheet.Activate
    
    
    ' ********************
    ' ファイルを開く
    ' ********************
    Dim Path As String
    Path = Application.GetOpenFilename("CSV,*.csv,全て,*.*", , "CSVファイルを選択して下さい")
    If Path = "False" Then
        Exit Sub
    End If
    
    ' ********************
    ' オープン
    ' ********************
    On Error Resume Next
    Set InObj = ThisWorkbook.Fs.OpenTextFile(Path, 1)
    If Err.Number <> 0 Then
        MsgBox (Err.Description)
        Exit Sub
    End If
    On Error GoTo 0
    
    Dim Buffer As String
    Dim Data() As String
    ' ********************
    ' CSV ファイルより
    ' データを読み込み
    ' ********************
    
    row = 0
    Do While Not InObj.AtEndOfStream
        Buffer = InObj.ReadLine
        Data = Split(Buffer, ",")
        
        row = row + 1
        sheet.Cells(row + 1, 3).Value = Data(0)
        sheet.Cells(row + 1, 4).Value = Data(1)
    
    Loop

End Sub

ファイルアクセス用のオブジェクト作成

シートを開いた時に一度だけ実行するように、ThisWorkBook に作成しています。

Public Fs As Object

Private Sub Workbook_Open()

    Set Fs = CreateObject("Scripting.FileSystemObject")

End Sub

On Error Resume Next

VB と名の付く処理では伝統的なエラーの対処方法です。指定した名前のシートを取得する方法としては、シートのコレクションのループ内で一致する名前を探すのが VBA 界隈では一般的なようですが、VB アプリケーションとしてはこのほうが汎用性があります。

Call でシートのコピー

VBA のマクロが作成するコードは、これとは違うものだと思いますが、VB アプリケーションでメソッドの実行は Call で呼び出します。戻り値のある場合は Call を使わずに左辺に変数を置きます。

引数が一つの場合は、Call を使わずに実行でき、その際引数をかっこでは囲いません。しかし、引数が二つ以上の場合は Call を使って引数をかっこで囲います。ここでは、expression.Copy(Before, After) の文法にのっとって、第一引数を省略して、第二引数を指定してコピーしています。

VBA

Excel で 角丸四角形や1つの角を切り取った四角形で、角丸や切り取った長さを一定に設定する為の VBA Sub プロシージャ

Excel の VBA : ブックを開いたら、フォームを表示してボタンをクリックしたらセルにデータをセットする

VBA : Microsoft Access(.accdb) の読み込み

VBA : livedoor お天気API の JSON データを読み込んで利用する

VBA : シートの保護と部分的なセル入力の許可

VBA : 挿入した『テキストボックス』にアクセスする

VBA : InternetExplorer.Application 経由で JSON.parse を使用する方法

VBA : FileSystemObject でテキストファイル(CSV) を読み込んでセルにセットする