EXCELで簡易予約受付システム【スタンドアロン】を作る!

スポンサーリンク
050-VBA

超ド底辺システム管理者の管理人です。

久々にエクセルのマクロの作成依頼を受けましたが・・・

ホントウに久々だったのでほぼ完全に忘れていました。

いちいち簡単なコードでもすっかり忘れているので・・・

ポチポチとネットで調べながらの作業だったので、かなり疲れました。

EXCELで予約受付システム【スタンドアロン】を作る

オーダーは次のとおりです。

  • 説明会等の予約をエクセルで付け付けたい
  • 日付の指定あり
  • 時間帯の指定あり
  • 時間帯には人数枠がある
  • 当日来ない場合は郵送・その他とする
  • 入力項目は、氏名・電話番号・予約日・時間帯・備考
  • 適宜集計状況を見たい

こんな感じです。

スポンサーリンク

掛かった時間

VBAのコードをすっかり忘れていたので、一つ一つコードをネットで確認しながらの作業だったので、ほぼ丸一日掛かりました。

ただエラーがでた箇所は・・・

ChatGptに掛ければ修正してくれるので・・・

以前よりは格段に早くできたかと思います。

画面イメージは次のとおりです。

メニューと入力フォーム

入力されるリスト

リアルタイム集計画面

スポンサーリンク

日付ごとに時間帯枠の設定ができます。

定員の設定もできます。

ブログランキングにご協力ください!
ブログランキング・にほんブログ村へ

需要があるか分かりませんが・・・

マクロ付きエクセルのリンクを貼っておきます。

※ご利用は自己責任でお願いします。

コード

いちおうフォームのコードも貼り付けておきます。


Private Sub CommandButton1_Click()

'エラー設定
If UserForm1.Controls("name") = "" Or UserForm1.Controls("howchk") = "" Then
        MsgBox "入力されていません"
        Exit Sub
    Else
End If
    
'エラー設定
If UserForm1.Controls("howchk") = "説明会" And (UserForm1.Controls("ymdchk") = "" Or UserForm1.Controls("timechk") = "") Then
        MsgBox "日時が指定されていません"
        Exit Sub
    Else
End If

'エラー設定
If UserForm1.Controls("timechk") = "予約時間" Then
        MsgBox "時間を正しく設定してください"
        Exit Sub
    Else
End If


'シートリストの最大行を取得
Dim maxrow As Long
    
    maxrow = Worksheets("list").Cells(Rows.Count, 3).End(xlUp).Row

    Worksheets("list").Activate

'フォームの項目をシートlistに転記
'    ActiveSheet.Cells(maxrow + 1, 1) = CDate(Format(UserForm1.Controls("ymdchk"), "gee/mm/dd"))
    ActiveSheet.Cells(maxrow + 1, 1) = Format(UserForm1.Controls("ymdchk"), "gee/mm/dd")
'    ActiveSheet.Cells(maxrow + 1, 1).Offset(0, 1) = CDate(Format(UserForm1.Controls("timechk"), "hh:mm"))
    ActiveSheet.Cells(maxrow + 1, 1).Offset(0, 1) = Format(UserForm1.Controls("timechk"), "hh:mm")
    ActiveSheet.Cells(maxrow + 1, 1).Offset(0, 2) = UserForm1.Controls("name").Value
    ActiveSheet.Cells(maxrow + 1, 1).Offset(0, 3) = UserForm1.Controls("telno").Value
    ActiveSheet.Cells(maxrow + 1, 1).Offset(0, 4) = UserForm1.Controls("howchk").Value
    ActiveSheet.Cells(maxrow + 1, 1).Offset(0, 5) = UserForm1.Controls("etc").Value
    
    ActiveSheet.Cells(maxrow + 1, 1).Offset(0, 6) = Format(UserForm1.Controls("ymdchk"), "gee/mm/dd") & "-" & Format(UserForm1.Controls("timechk"), "hh:mm")

'フォームをクリア
    Call CommandButton2_Click
    
'シートPIVOTを表示
    Worksheets("PIVOT").Activate
 
'エクセルを全て再計算
    Application.Calculate
    
    
'シートPIVOTの計算範囲を再指定
    Dim ws As Worksheet
    Set ws = Worksheets("PIVOT")

    Dim pt As PivotTable
    Set pt = ws.PivotTables("ピボットテーブル1")

    pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Worksheets("list").Range("A1:G10000"))

'PIVOTテーブルを更新
    ActiveWorkbook.RefreshAll
    

End Sub

Private Sub CommandButton2_Click()

'クリアボタンを押したら
'日付と時間のチェックボックスを再表示せる
    UserForm1.ymd.Visible = True
    UserForm1.time.Visible = True

'全てのオブジェクトをクリアする
    Dim allcontrols As Control
    
    For Each allcontrols In UserForm1.Controls
        If TypeName(allcontrols) = "TextBox" Then
            allcontrols.Value = ""
        ElseIf TypeName(allcontrols) = "CheckBox" Then
            allcontrols.Value = False
        ElseIf TypeName(allcontrols) = "OptionButton" Then
            allcontrols.Value = False
        End If
    Next allcontrols

'時間のキャプションをリセットする
    For i = 1 To 16
        UserForm1.Controls("time" & i).Visible = True
        UserForm1.Controls("time" & i).Caption = "予約時間"
    Next

End Sub

Private Sub how1_Click()
'方法を説明会にする
    UserForm1.Controls("howchk") = "説明会"
'日付と時間のオブジェクトを表示にする
    UserForm1.ymd.Visible = True
    UserForm1.time.Visible = True
End Sub

Private Sub how2_Click()
'郵送をくりっくしたら
'日付と時間のオブジェクトを非表示にする
    UserForm1.ymd.Visible = False
    UserForm1.time.Visible = False
'方法を郵送にする
    UserForm1.Controls("howchk") = "郵送"
'日付と時間を消す
    UserForm1.Controls("ymdchk").Value = ""
    UserForm1.Controls("timechk").Value = ""
End Sub

Private Sub how3_Click()
'その他をくりっくしたら
'日付と時間のオブジェクトを非表示にする
    UserForm1.ymd.Visible = False
    UserForm1.time.Visible = False
'方法をその他にする
    UserForm1.Controls("howchk") = "その他"
'日付と時間を消す
    UserForm1.Controls("ymdchk").Value = ""
    UserForm1.Controls("timechk").Value = ""
End Sub



Private Sub UserForm_Initialize()
'ユーザーフォームを読み込んだとき

Dim stname As String

'エクセルの日付シート(dayN)からフォームに日付を表示する
    For i = 1 To 5
        stname = "day" & i
    
            If Worksheets(stname).Range("B1") <> "" Then
                UserForm1.Controls("ymd" & i).Visible = True
                UserForm1.Controls("ymd" & i).Caption = Format(Worksheets(stname).Range("B1"), "gee/mm/dd")
            Else
                UserForm1.Controls("ymd" & i).Visible = False
            End If

    Next
    
End Sub

Private Function timeset()

'変数の定義
Dim daycheckbox As Control
Dim stname As String
Dim boxname As String

'時間のオブジェクトを全て表示
For i = 1 To 16
    UserForm1.Controls("time" & i).Visible = True
Next

'日付のチェックボックスの内容を確認
    For i = 1 To 5
        stname = "day" & i
        boxname = "ymd" & i
          
            '日付のチェックボックスがTRUEだったら
            If UserForm1.Controls(boxname).Value = True Then
                UserForm1.Controls("ymdchk") = Format(UserForm1.Controls(boxname).Caption, "gee/mm/dd")
                
                '方法を説明会にする
                UserForm1.Controls("howchk") = "説明会"
            
                        '該当する日付の予約可能時間帯を表示させる
                        For j = 1 To 16
                            If Worksheets(stname).Cells(4 + j, 3) = "する" Then
                                UserForm1.Controls("time" & j).Caption = Format(Worksheets(stname).Cells(4 + j, 1), "hh:mm") & " 残枠 " & Worksheets(stname).Cells(4 + j, 5)
                            Else
                                UserForm1.Controls("time" & j).Visible = False
                            End If
                        Next
                        
            Else
            End If
    Next


End Function

Private Sub ymd1_Click()
'日付1を選んだら
    Call timeset
End Sub

Private Sub ymd2_Click()
'日付2を選んだら
    Call timeset
End Sub

Private Sub ymd3_Click()
'日付3を選んだら
    Call timeset
End Sub

Private Sub ymd4_Click()
'日付4を選んだら
    Call timeset
End Sub

Private Sub ymd5_Click()
'日付5を選んだら
    Call timeset
End Sub

Private Function timeadd()

Dim timebox As Control

    For Each timebox In UserForm1.time.Controls
            If timebox.Value = True Then
            
                '方法を説明会にする
                UserForm1.Controls("howchk") = "説明会"
                
                '時間を取得する
                UserForm1.Controls("timechk").Value = Left(timebox.Caption, 5)
            Else
            End If
    Next
    
End Function

Private Sub time1_Click()
    Call timeadd
End Sub
Private Sub time2_Click()
    Call timeadd
End Sub
Private Sub time3_Click()
    Call timeadd
End Sub
Private Sub time4_Click()
    Call timeadd
End Sub
Private Sub time5_Click()
    Call timeadd
End Sub
Private Sub time6_Click()
    Call timeadd
End Sub
Private Sub time7_Click()
    Call timeadd
End Sub
Private Sub time8_Click()
    Call timeadd
End Sub
Private Sub time9_Click()
    Call timeadd
End Sub
Private Sub time10_Click()
    Call timeadd
End Sub
Private Sub time11_Click()
    Call timeadd
End Sub
Private Sub time12_Click()
    Call timeadd
End Sub
Private Sub time13_Click()
    Call timeadd
End Sub
Private Sub time14_Click()
    Call timeadd
End Sub
Private Sub time15_Click()
    Call timeadd
End Sub
Private Sub time16_Click()
    Call timeadd
End Sub

ブログ開設に必要なドメイン取得、サーバーレンタル、ASPの登録等は、こちらのサイトから!

コメント

タイトルとURLをコピーしました