[実験]エクセルのシフト表をGoogleカレンダーに反映[してみる]その3

久方ぶりです。
取り合えず、エクセルのvisual basicのコードを・・
かなり適当に書いてます。
シート1枚目をマスタとして、2シート目以降をシフト表としています。


マスタシートのA・B列を時給、D・E列を祝日、E・F列をGoogleカレンダーとの連携項目
※F1でGoogleカレンダーを使用するかどうかを設定します。「1」を設定すると使用する感じです。


シフト表では5行目から開始日となりその対象付き分列が出来上があります。
D列:日給
E列:その日の稼働時間
FGHIJK列はそれぞれの早朝・通常・深夜の金額と稼働となります。
また、38行目が、月の合計を表示します。
M列からは時間を15分刻みでセルを作成します。稼働している時間には「1」を設定します。
※シート内の見た目はなんかいろいろやっているので省きます。

以下、エクセルに記述したコードになります。

Public Function insCallendar(ByVal query As String)
    Dim objXMLHttp As Object
    Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
    objXMLHttp.Open "POST", "https://ドメイン/hoge.php", False
    objXMLHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
    Dim postData As String
    postData = query
    objXMLHttp.Send (postData)
End Function
Option Explicit
Const c_row = 5
Const c_col = 13
Const c_days = 30
Const c_times = (25 - 6) * 4

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim gc_flg As String
    gc_flg = Worksheets(1).Cells(1, 7).Value
    If (gc_flg = "1") Then
        Dim calendar_id As String
        Dim calendar_title As String
        calendar_id = Worksheets(1).Cells(2, 7).Value
        calendar_title = Worksheets(1).Cells(3, 7).Value
        Dim i, n, yms As Long
        Dim re As New RegExp
        re.Global = True
        re.Pattern = "^(\d+)$"
        n = 0
        Dim sheets As Object
        Set sheets = CreateObject("Scripting.Dictionary")
        For i = 1 To Worksheets.Count
            If (Worksheets(i).Name = "マスタ") Then
            Else
                If (re.test(Worksheets(i).Name)) Then
                    If (Worksheets(i).Name >= Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyymm")) Then
                        Dim s As String
                        s = Worksheets(i).Name
                        sheets.Add n, s
                        n = n + 1
                    Else
                    End If
                End If
            End If
        Next
        Dim row As Long
        Dim col As Long
        Dim obj_time As Object
        Dim day As String
        Dim remark As String
        Dim tmp_f As String
        Dim tmp_t As String
        Dim flg As Boolean
        Dim end_flg As Boolean
        Dim query As String
        Dim min_d, max_d As String
        min_d = ""
        max_d = ""
        query = "calendar_id=" & calendar_id
        query = query & "&calendar_title=" & calendar_title
        Dim ym As String
        ym = Format(Date, "yyyymm")
        Dim test As Object
        For yms = 0 To sheets.Count
            If (sheets(yms) <> "") Then
                For row = c_row To (c_row + c_days)
                    day = Worksheets(sheets(yms)).Cells(row, 1).Value
                    If (day <> "") Then
                        If (day < min_d Or min_d = "") Then min_d = day ' 対象のシートで一番古い日付を取得 End If If (day > max_d) Then
                            max_d = day ' 対象のシートで一番新しい日付を取得
                        End If
                        remark = Worksheets(sheets(yms)).Cells(row, 3).Value
                        tmp_f = ""
                        tmp_t = ""
                        flg = False
                        end_flg = False
                        For col = c_col To (c_col + c_times - 1)
                            Dim tmp_h As Integer
                            tmp_h = ((col - c_col) \ 4) 
                            If (tmp_f = "" And flg = False And Worksheets(sheets(yms)).Cells(row, col).Value = 1) Then
                                If (((col - c_col) Mod 4) = 0) Then
                                    tmp_f = (tmp_h + 6) & ":00"
                                Else
                                    tmp_f = (tmp_h + 6) & ":" & ((col - c_col) Mod 4) * 15
                                End If
                                flg = True
                            ElseIf (tmp_f <> "" And flg = True And Worksheets(sheets(yms)).Cells(row, col).Value = 1) Then
                                If ((((col - c_col) Mod 4) * 15 + 15) = 60) Then
                                    tmp_t = (tmp_h + 6 + 1) & ":00"
                                Else
                                    tmp_t = (tmp_h + 6) & ":" & (((col - c_col) Mod 4) * 15 + 15)
                                End If
                                flg = True
                            ElseIf (flg = True & Worksheets(sheets(yms)).Cells(row, col).Value = "") Then
                                end_flg = True
                            Else
                            End If
                        Next col
                        If (tmp_f <> "" And tmp_t <> "") Then
                            If (query <> "") Then
                                query = query & "&"
                            Else
                            End If
                            query = query & _
                                "day[" & day & "]=" & day & _
                                "&day[" & day & "][remark]=" & remark & _
                                "&day[" & day & "][f]=" & tmp_f & _
                                "&day[" & day & "][t]=" & tmp_t
                        End If
                    End If
                Next row
            End If
        Next yms
        If (query <> "") Then
            query = query & "&min_d=" & min_d & "&max_d=" & max_d
        Else
        End If
        insCallendar (query)
    End If
End Sub

次回は、php側を・・・・

スポンサーリンク

コメントを残す

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

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください