基データファイルから、希望するカレンダーイベントを抽出して、Google カレンダーにインポートできる CSV のスプレッドシートを作る作業。
これをマクロでやってみる。
ここからマクロの作業とする.
以下を Copilot に依頼する
月単位の行事予定が入力されたダウンロードしたエクセルファイルから、Googleカレンダーを作るためにGoogleカレンダーのスプレッドシートのCSVファイルを作りたい。
以下の作業が行えるよう、Excel VBA のマクロコードを生成してください。
1. はじめに、メッセージボックスに、"Myパソカレンダーを作成します。"と表示する。
2. メッセージボックスで"希望するイベント項目を(複数)選択してください。最後に「OK」をクリックしてください。"と表示する。
3. カレンダーとして抽出するイベント名が表示されたチェックボックスが複数配置されたユーザーフォーム(UserForm1) があるのでこれを表示する。そこでユーザーは希望するイベントを複数選択する。最後にCommandButton1の「OK」をクリックする。
4. 「OK」が押されると、入力された抽出イベントリストはまとめられ、のちほどイベントをGoogleカレンダーエントリーに載せるかどうかの判断に使われる。UserForm1は非表示となる。
5. イベント選択が終わったら、メッセージボックスに〟"基データファイルを開きます。”と表示し、パソボラのWebサイト「活動予定表」から活動予定の入力されたエクセルファイルをダウンロードするよう指示する。
6. エクスプローラーを開く。
7. 保存した”基データ”エクセルファイルを開くようにユーザーに促す。
8. 何月のカレンダーを作るかをinputでユーザーに聞く。ユーザーがインプットした月の数字を半角文字に変換する。
9. ”基データ”ファイルで、入力された月のシートを選ぶ、シート名は入力された値と"月"が連結されている。該当のシートが無い場合は、"その月のシートはありません。"と応答し、再度入力するかどうかを確認し、再度入力する場合は,再度入力させる。それ以外は操作を終了する。
10. 作成される CSV ファイルの保存先を設定する。保存先は、当マクロブックが保存されているフォルダーと同じにする。ファイル名は文字列「MyPasoCalendar」に、選択した「月」を連結接続させたものにする。
11. 表示されるシートのB列から始める。B列のセルB9から下方に記述されているイベントがカレンダーのエントリー候補となる。
12. この列で見つかるイベントには文字「~」が含まれているものとする。含まれていない場合はカレンダーのエントリーとせず、次のエントリーを探す。
13. セルに "↑" あるいは "終了後" が含まれているイベントは抽出しないで次のエントリーを探す。
14. まず Subject の設定では、B列からE列の場合は、イベントに入力されていて最初の半角スペース直前までの文字列に、それぞれの列の5番目のセル、すなわちセル B5、C5、D5、E5 の内容2文字を接続したものを Subject とする。
15. この Subject の文字列の中に、フォームUserForm1で選択した抽出リストの文字列と合致するものがあれば、作成するカレンダーのエントリーとする。
16. Start Date はイベントが記述されている行の最も左端の列、すなわちA列にある年月日にする。
17. Start Time は、イベントが記述されているセル内容に、「開始時間~終了時間」と記述されているので、~の前の最長5文字とする。
18. End Date は上記 13 と同じ値を使う、
19. End Time はイベントが記述されているセル内容に、「開始時間~終了時間」と記述されているので、~の後ろの最長5文字とする。
20. Description は無し、
21. セル内容に文字列「Web」が含まれる場合は、Location を「Web」とする
22. B列からE列の場合の Location は同じ表のセルB8の内容とする、
23. All Day Event 及び Private はブランクにする。
24. これで一つのイベントをカレンダーイベントに変換する作業は終了する。イベント内に改行コードがあればそれを削除したカレンダーイベントにする。
25. この作業を、B列にある他のイベントすべてについて繰り返す。
26. 次にC列に移動する。
27. ここも同じようにC列のセルC9以下に記述されているイベント全てをカレンダーのエントリーとする。その内容はB列で行った方法と同じ。但しSubjectはイベントに入力されている文字列の最初の半角スペース直前までの漢字と数字の計3文字とセルC5の内容を接続し組み合わせたものにする。
28. C列が終了したら次にD列に移動する。ここでのSubjectはイベントに入力されている漢字と数字の計3文字とセルD5の内容を組み合わせたものにする。
29. D列のすべてのイベントが終了したら、E列へ移動する。
30. セルE9以下の下方に入力されているすべてのイベントから、同様にGoogleカレンダーのエントリーを作る。但しSubjectは イベントに入力されている漢字だけとし、漢字が '学習会' の場合だけセルE5の内容の左から2文字を組み合わせたものを Subject とする。
31. E列のすべてのエントリーが終了したら、F列へ移動する。セルF9以下に記述されているイベントがあればGoogleカレンダーのエントリーに変換する。この場合、Subject はセルに入力されている漢字文字のみとする。
32. F列終了後G列へ移動する。同様に、セルG9以下にイベントが記述されていればGoogleカレンダーのエントリーに変換する。この場合、Subjectはセルに入力されている漢字文字のみとする。
33. G列終了後H列へ移動する。同様に、セルH9以下にイベントが記述されていればGoogkeカレンダーのエントリーに変換する。この場合、Subjectはセルに入力されている漢字文字のみとする。
34. H列終了後I列へ移動する。同様に、セルI9以下にイベントが記述されていればGoogleカレンダーのエントリーに変換する。この場合、Subjectはセルに入力されている漢字文字のみとする。
35. I列終了後J列へ移動する。同様に、セルJ9以下にイベントが記述されていればGoogleカレンダーのエントリーに変換する。この場合、Subjectはセルに入力されている漢字文字のみとする。 同様に、セルJ9以下にイベントが記述されていて、Subjectが「A班」「B班」「C班」「D班」のいずれかであれば、Start DateとEnd Dateは同じ行のA列の値、Subjectに"AM"があれば、Start Timeは"09:30"、End Timeは"12:30"、"PM"があれば、Start Timeは"13:30"、End Timeは"16:30"とする。
36. J列で、Subjectに"生活支援C"がある場合は、Start Timeは"14:00"、End Timeは"16:00"とする。
37. J列終了後K列へ移動する。同様に、セルK9以下にイベントが記述されていればGoogleカレンダーのエントリーに変換する。この場合、Subjectはセルに入力されている漢字文字のみとする。 K列で、同様に、セルK9以下にイベントが記述されていて、Subjectが「A班」「B班」「C班」「D班」のいずれかであれば、Start DateとEnd Dateは同じ行のA列の値、Subjectに"AM"があれば、Start Timeは"09:30"、EndT imeは"12:30"、"PM"があれば、Start Timeは"13:30"、End Timeは"16:30"とする。
38. またSubjectに"イオン"がある場合は、Start Timeは"14:00"、End Timeは"17:00"とする。
39. 以上が終了すると、作成していたCSVラインに改行コードがあれば削除してCSVファイルを保存して閉じる。
40. 保存が完了したらメッセージを表示し、一連の作業を終了する。
了解しました。複数選択ができるようにするために、UserForm1 にチェックボックス(CheckBox)を配置し、選択されたイベントを取得する方法を提供します。
まず、以下の手順で UserForm1 を作成します:
ExcelのVBAエディタで、Insert メニューから UserForm1 を選択します。
UserForm1 にチェックボックス(CheckBox)を配置し、各チェックボックスにイベント名を設定します。
UserForm1 に「OK」ボタンを配置し、クリック時に選択されたイベントを取得するコードを追加します。
以下に、UserForm1 のコードとメインのサブプロシージャのコードを示します。
・・・ この後、
思い通りにならないことや、もう少し良くしたいなどがあって、その都度修正をお願いすると、即座に、しかも丁寧に修正をしてくれ、しかもその修正の意味を説明してくれる。
また、同じお願いのはずだが、別の人がお願いすると同じ内容でないとか、同じ人でも別の日にお願いすると、異なった内容だったりするのには、困惑しきりとされることもあった。
過去の履歴を引きずらないように新しいトピックだとして始めたとしても、名前を隠すためにサインアウトして問い合わせたとしても、毎回異なることもある。AIは機械だと思っていたのに、いつも必ずしも同じようにはならないということで、これぞまさしく人間的なのかもしれない。
いずれにしても共通的に言えるのは、AIは、どれほどしつこく聞いても、決して怒ると言うことはない。辛抱強く、即座に答えてくれる。
AIとの付き合い方としては、AIの回答は必ずしもいつも正しいとは限らない、回答に納得するのもしないのも、AIを使う側の人間が判断するということを実感した次第だ。
そういう状況なので、今回の勉強会で全員が納得するようになるには、個々に疑問点や修正点を出してそれに回答をもらい試してみる、ということを繰り返す必要がある。
これを集団での勉強会の中でやると、時間がいくらあっても足りないので、1つのマクロの例を皆で共有して進めることとしたい。
何回かのやり取りがあって、現時点で使えると思われる、確定したコードが、以下に示すようにあるので、これを全員で共有して、この後を続けたい。
もちろん個々にやり取りを続けてご自分のコードを完成させて頂くことも大歓迎です。
以下のコードをコピー&ペーストで、マクロブック「Myパソカレンダー作成マクロ.xlsm」の、【ユーザーフォーム】のコードと【メインプロシージャ】のコードに貼り付けます。
【UserForm1】 のコード
Private selectedEvents As Collection
Private Sub CommandButton1_Click()
' チェックボックスの選択を確認
Set selectedEvents = New Collection
If CheckBox1.Value Then selectedEvents.Add CheckBox1.Caption
If CheckBox2.Value Then selectedEvents.Add CheckBox2.Caption
If CheckBox3.Value Then selectedEvents.Add CheckBox3.Caption
If CheckBox4.Value Then selectedEvents.Add CheckBox4.Caption
If CheckBox5.Value Then selectedEvents.Add CheckBox5.Caption
If CheckBox6.Value Then selectedEvents.Add CheckBox6.Caption
If CheckBox7.Value Then selectedEvents.Add CheckBox7.Caption
If CheckBox8.Value Then selectedEvents.Add CheckBox8.Caption
If CheckBox9.Value Then selectedEvents.Add CheckBox9.Caption
If CheckBox10.Value Then selectedEvents.Add CheckBox10.Caption
If CheckBox11.Value Then selectedEvents.Add CheckBox11.Caption
If CheckBox12.Value Then selectedEvents.Add CheckBox12.Caption
If CheckBox13.Value Then selectedEvents.Add CheckBox13.Caption
If CheckBox14.Value Then selectedEvents.Add CheckBox14.Caption
If CheckBox15.Value Then selectedEvents.Add CheckBox15.Caption
If CheckBox16.Value Then selectedEvents.Add CheckBox16.Caption
If CheckBox17.Value Then selectedEvents.Add CheckBox17.Caption
If CheckBox18.Value Then selectedEvents.Add CheckBox18.Caption
' UserFormを閉じる
Me.Hide
End Sub
Public Function GetSelectedEvents() As Collection
' UserFormを表示
Me.Show
' 選択されたイベントを返す
Set GetSelectedEvents = selectedEvents
End Function
【メインのサブプロシージャ】のコード
Sub CreateGoogleCalendarCSV() 'as of 2024/10/16
Dim ws As Worksheet
Dim csvFile As String
Dim monthInput As String
Dim monthSheet As String
Dim lastRow As Long
Dim i As Long
Dim eventCount As Integer
Dim csvLine As String
Dim csvMonth
Dim csvContent As String
Dim eventSubject As String
Dim startDate As String
Dim startTime As String
Dim endDate As String
Dim endTime As String
Dim location As String
Dim wb As Workbook
Dim selectedEvents As Collection
Dim eventFound As Boolean
Dim eventForm As Object
MsgBox "希望するイベント項目を(複数)選択してください。"
' UserFormを作成
Set eventForm = New UserForm1
' イベント選択を求める
Set selectedEvents = eventForm.GetSelectedEvents
MsgBox "基データファイルを開きます。"
' エクスプローラを起動してファイルを開く
Application.Dialogs(xlDialogOpen).Show
Set wb = ActiveWorkbook
' 月の入力を求める
monthInput = InputBox("何月のカレンダーを作成しますか?(1~12の数字を入力してください)")
monthSheet = CStr(CInt(monthInput)) & "月"
csvMonth = CStr(CInt(monthInput))
' 指定された月のシートを選択
Set ws = wb.Sheets(monthSheet)
' CSVファイルのパスを設定、ファイル名に入力した月を入れる
csvFile = Application.GetSaveAsFilename("MyPasoCalendar" & csvMonth & ".csv", "CSVファイル (*.csv), *.csv")
' CSVファイルのヘッダーを設定
csvContent = "Subject,Start Date,Start Time,End Date,End Time,Description,Location,All Day Event,Private" & vbCrLf
' B列のイベントを処理
ExtractEvents ws, 2, selectedEvents, csvContent, eventCount
' C列のイベントを処理
ExtractEvents ws, 3, selectedEvents, csvContent, eventCount
' D列以降のイベントを処理
Dim col As Integer
For col = 4 To 11 ' D列からK列まで
ExtractEvents ws, col, selectedEvents, csvContent, eventCount
Next col
' CSVファイルを保存
Open csvFile For Output As #1
Print #1, csvContent
Close #1
MsgBox "GoogleカレンダーのCSVファイルが作成されました。"
End Sub
Sub ExtractEvents(ws As Worksheet, column As Integer, selectedEvents As Collection, ByRef csvContent As String, ByRef eventCount As Integer)
Dim lastRow As Long
Dim i As Long
Dim eventSubject As String
Dim startDate As String
Dim startTime As String
Dim endDate As String
Dim endTime As String
Dim location As String
Dim csvLine As String
Dim eventFound As Boolean
Dim selectedEvent As Variant
Dim pos As Integer
lastRow = ws.Cells(ws.Rows.Count, column).End(xlUp).Row
For i = 9 To lastRow
If ws.Cells(i, column).Value <> "" Then
eventSubject = ws.Cells(i, column).Value
'セルに"↑"あるいは"終了後"が含まれているイベントは抽出しない
If InStr(eventSubject, "↑") > 0 Or InStr(eventSubject, "終了後") > 0 Then
GoTo Nx
End If
If column < 5 Then '列がEからK迄の場合班名は繋げない
'講座名に班名(各列セル5)を繋げる
pos = InStr(eventSubject, " ")
If pos > 0 Then
eventSubject = Left(eventSubject, pos - 1) & Left(ws.Cells(5, column).Value, 2) & Mid(eventSubject, pos)
End If
End If
eventFound = False
For Each selectedEvent In selectedEvents
If InStr(eventSubject, selectedEvent) > 0 Then
eventFound = True
Exit For
End If
Next selectedEvent
If eventFound Then
' Start Timeを「~」の前の5文字に設定
pos = InStr(eventSubject, "~")
If pos > 5 Then
startTime = Mid(eventSubject, pos - 5, 5)
Else
startTime = ""
End If
' End Timeを「~」の後の文字に設定
If pos > 0 Then
endTime = Mid(eventSubject, pos + 1)
Else
endTime = ""
End If
' Subjectを最初の半角スペース直前までの文字に設定
pos = InStr(eventSubject, " ")
If pos > 0 Then
eventSubject = Left(eventSubject, pos - 1)
End If
' Locationに「Web」が含まれている場合
If InStr(ws.Cells(i, column).Value, "Web") > 0 Then
location = "Web"
Else
'カラム3,4,5の場合
Select Case column
Case 2
location = ws.Cells(8, column).Value
Case 3 To 5
location = ws.Cells(8, 2).Value
End Select
End If
If column = 2 Then ' B列
eventSubject = Left(eventSubject, 3) & ws.Cells(5, column).Value
ElseIf column = 3 Then ' C列
If eventCount < 6 Then
eventSubject = Left(eventSubject, 3) & ws.Cells(5, column).Value
eventCount = eventCount + 1
End If
ElseIf column = 4 Then ' D列
eventSubject = Left(eventSubject, 3) & ws.Cells(5, column).Value
ElseIf column = 5 Then ' E列
If InStr(eventSubject, "学習会") > 0 Then
eventSubject = eventSubject & Left(ws.Cells(5, column).Value, 2)
End If
ElseIf column = 10 Or column = 11 Then ' J列, K列
eventSubject = eventSubject
startDate = ws.Cells(i, "A").Value
endDate = startDate
If InStr(eventSubject, "AM") > 0 Then
startTime = "09:30"
endTime = "12:30"
Else
startTime = "13:30"
endTime = "16:30"
End If
If InStr(eventSubject, "生活支援C") > 0 Then
startTime = "14:00"
endTime = "16:00"
End If
If InStr(eventSubject, "イオン") > 0 Then
startTime = "14:00"
endTime = "17:00"
End If
csvLine = eventSubject & "," & startDate & "," & startTime & "," & endDate & "," & endTime & ",," & location & ",,"
csvLine = Replace(csvLine, vbCrLf, "") ' 改行コードを削除
csvLine = Replace(csvLine, vbLf, "") ' 改行コードを削除
csvLine = Replace(csvLine, vbCr, "") ' 改行コードを削除
csvContent = csvContent & csvLine & vbCrLf
Else
eventSubject = eventSubject
End If
If column <> 10 And column <> 11 Then
startDate = ws.Cells(i, "A").Value
endDate = startDate
csvLine = eventSubject & "," & startDate & "," & startTime & "," & endDate & "," & endTime & ",," & location & ",,"
csvLine = Replace(csvLine, vbCrLf, "") ' 改行コードを削除
csvLine = Replace(csvLine, vbLf, "") ' 改行コードを削除
csvLine = Replace(csvLine, vbCr, "") ' 改行コードを削除
csvContent = csvContent & csvLine & vbCrLf
End If
End If
End If
Nx:
Next i
End Sub
変更したマクロブックにバージョン番号(vxx)を付けて、「名前を付けて保存」する:
・保存フォルダー:「マクロの練習」>「カレンダー」
・ファイルの種類:「マクロ有効ブック(*.xlsm)」
・フ ァ イ ル 名:「Myパソカレンダー作成マクロ_v01.xlsm」
😊この後もフォームやマクロに変更がある場合はバージョン番号を付けて保存しよう!
保存先フォルダー:「マクロの練習」>「カレンダー」フォルダー
CSV ファイル名:「"MyPasoCalendar" & csvMonth & ".csv"」(csvMonth は入力したカレンダー作成月)
全項目選択(すべての項目にチェックを入れた)の場合:
ここでは、「B班」「HP勉強会」「運営委員会」「四役会」「希望の家」「学習会」「お楽しみクラブ」を選択してCSVを作成してみた: