概要 "対象" という名前のシートがあればそれを使い、無ければ "テンプレート" シートをコピーして、"対象" と言う名前に変更します。そのシートに対して、指定した年月の 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) の文法にのっとって、第一引数を省略して、第二引数を指定してコピーしています。
そして、マクロ有効ブックとして保存します
次に、開発タブより『コードの表示』をクリックしてコードを表示します
ユーザフォームを追加して、フォームにボタンを作成します
ボタンを追加するツールウインドウを閉じた場合は、フォームをクリックして選択し、表示メニューより選択して表示させます
ボタンをクリックした時の処理を記述するため、フォームのボタンをダブルクリックしてクリックイベントを表示させ、まずテストの為にメッセージボックスを表示させるコードを記述します
ブックを開いた時にフォームを表示させる為に、ThisWorkBook をダブルクリックしてエディタを表示させ、Open イベントを選択して以下のように記述します
ここまでで保存して、いったん Excel を終了させてから再度開き、フォームが表示される事を確認します
最後に、ボタンのイベントに以下のコードを追加してセルへのデータ転送のテストを行います
その為には入力対象のセルに対してロックのチェックを外すという操作が手作業の場合は必要ですが、VBA で実行すると以下のようになります
※ エキスパートモードで表示しています
アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります
