Option Explicit
'月別給与賞与支払一覧表

Private mobjWS() As Worksheet
'mobjWS(0)：ThisWorkbooks.Sheet4
'mobjWS(1)：Sheet1：基礎情報
'mobjWS(2)：Sheet2：社員情報
'mobjWS(3)：Sheet5：給与賞与情報

Private mclsSyain() As clsList  '社員クラス
Private mlngRow As Long         '社員データ数
Private mlngRow2 As Long        '給与賞与データ数
Private mintFlg As Integer      '給与賞与区分フラグ

'閉じるボタン
Private Sub cmdEND_Click()

    Unload Me
    
End Sub

'登録ボタン
Private Sub cmdOK_Click()

    Dim intMsg As Integer   'メッセージの戻り値
    
    Call LetData
    Call KomokuSum
    Call LineSet
    Call SetKomoku(mintFlg)
    
    intMsg = MsgBox("正常に集計しました。" & vbCrLf & "続けて印刷しますか", 32 + 4, "給与計算システム")
    
    If intMsg = 6 Then
        Unload Me
        '過去データアクセス許可による分岐
        If mdlMain.gKakoFlg = False Then mdlPrint.PrintItiranHyou
        If mdlMain.gKakoFlg = True Then mdlTool.PrintItiranHyou_Old
    ElseIf intMsg = 7 Then
        mobjWS(0).Activate
        mobjWS(0).Range(Cells(5, 1), Cells(65536, 14)).Clear
        If Me.lstDate.Enabled = True Then Me.lstDate.Enabled = False
        If Me.cmdOK.Enabled = True Then Me.cmdOK.Enabled = False
    End If
    
End Sub

'支給日リスト選択
Private Sub lstDate_Click()

    If Me.cmdOK.Enabled = False Then Me.cmdOK.Enabled = True
    
End Sub

'フォームロード時
Private Sub UserForm_Initialize()

    Call NewData
    Call GetDateList
    Call GetSyainList
    
End Sub

'フォームクローズ
Private Sub UserForm_Terminate()

    Dim i As Long   '長整数型カウンタ
    
    '配列の開放
    If IsEmpty(mobjWS) = True Then Erase mobjWS
    'クラスの開放
    For i = 0 To mlngRow - 1
        Set mclsSyain(i) = Nothing
    Next
    'オブジェクトの開放
    For i = 0 To 3
        Set mobjWS(i) = Nothing
    Next
    
End Sub

'ユーザー設定項目
Private Sub SetKomoku(ByVal intKubun As Integer)
'引数[intKubun]：給与賞与区分

    Dim i As Integer
    
    Select Case intKubun
        Case Is = 0
            For i = 1 To 9
                If i < 6 Then mobjWS(0).Cells(3, i + 7).Value = mobjWS(1).Cells(4, i).Value
                If i > 5 Then mobjWS(0).Cells(4, i + 1).Value = mobjWS(1).Cells(4, i).Value
            Next
        Case Is = 1
            For i = 1 To 3
                mobjWS(0).Cells(4, i + 6).Value = mobjWS(1).Cells(5, i).Value
            Next
    End Select
    
End Sub

'罫線
Private Sub LineSet()

    Dim lngRow As Long      'レコード
    
    'ワークシートとレコード取得
    lngRow = mobjWS(0).Cells(65536, 14).End(xlUp).Row
    'データがないとき
    If lngRow = 4 Then Exit Sub
    
    '-----罫線-----
    mobjWS(0).Activate
    mobjWS(0).Range(Cells(5, 1), Cells(lngRow, 14)).Borders(xlInsideVertical).LineStyle = xlContinuous
    
End Sub

'項目ごとの合計
Private Sub KomokuSum()

    Dim lngGoukei As Long   '合計金額
    Dim lngRow As Long      '集計レコード数
    Dim i As Long           '長整数型カウンタ
    Dim j As Integer        '整数型カウンタ
    Const intBai As Integer = 2 '1データ2行整列のため倍にする
    
    mlngRow2 = mlngRow2 * intBai
    
    For i = 5 To mlngRow2 + 4
        If mobjWS(0).Cells(i, 2).Value <> "" Then
            '合計
            For j = 2 To 13
                lngGoukei = lngGoukei + CLng(mobjWS(0).Cells(i, j).Value)
            Next
            'データの書き出し
            With mobjWS(0).Cells(i, 14)
                .Value = Format$(lngGoukei, "#,##0")
                'あみ掛け
                If mobjWS(0).Cells(i, 13).Interior.ColorIndex = 37 Then
                    With .Interior
                        .ColorIndex = 37
                        .Pattern = xlSolid
                    End With
                End If
            End With
            lngGoukei = 0
        Else
            Exit For
        End If
    Next
    
    lngRow = mobjWS(0).Cells(65536, 2).End(xlUp).Row
    mobjWS(0).Activate
    For j = 2 To 14
        mobjWS(0).Cells(lngRow + 1, j).Value = Format$(mdlFunction.SkipSum(2, 1, Range(Cells(5, j), Cells(lngRow, j))), "#,##0")
        mobjWS(0).Cells(lngRow + 2, j).Value = Format$(mdlFunction.SkipSum(2, 0, Range(Cells(5, j), Cells(lngRow, j))), "#,##0")
    Next
    
    mobjWS(0).Cells(lngRow + 1, 1).Value = "合計"
    mobjWS(0).Cells(lngRow + 2, 1).Value = "合計"
    
End Sub

'データの書き出し
Private Sub LetData()

    Dim clsData As clsSalary    '給与賞与データクラス
    Dim datSikyu As Date        '支給日
    Dim A() As Variant          '給与賞与データ格納
    Dim B() As Variant          '社員データ格納
    Dim i As Long               '長整数型カウンタ
    Dim j As Long               'カレントレコード
    Dim k As Integer            '整数型カウンタ
    Dim l As Long               '長整数型カウンタ
    Dim m As Long               '長整数型カウンタ
    Dim n As Long               '対象レコード数
    
    ReDim A(24) As Variant      '配列再定義
    
    'フラグの立てる
    mobjWS(0).Cells(1, 1).Value = 0
    '支給日の取得
    datSikyu = CDate(Me.lstDate.List(Me.lstDate.ListIndex, 1))
    'クラスのインスタンス
    Set clsData = New clsSalary
    
    i = 1
    Do Until mobjWS(3).Cells(i, 4).Value = ""
        If CDate(mobjWS(3).Cells(i, 4).Value) = datSikyu Then
            n = n + 1
            mintFlg = CInt(mobjWS(3).Cells(i, 3).Value)
        End If
        i = i + 1
    Loop
    
    '給与データの処理
    i = 1
    Do Until mobjWS(3).Cells(i, 4).Value = ""
        If CDate(mobjWS(3).Cells(i, 4).Value) = datSikyu Then
            clsData.GetProperty mobjWS(3), i, A(0), A(1), A(2), A(3), A(4), A(5), A(6), A(7), A(8), A(9), _
                            A(10), A(11), A(12), A(13), A(14), A(15), A(16), A(17), A(18), A(19), _
                            A(20), A(21), A(22), A(23), A(24)
        
            'データの検査
            'If A(2) = 0 Then
                'カレントレコードの取得
                If mobjWS(0).Cells(1, 1).Value = 0 Then
                    j = 5
                    mobjWS(0).Cells(1, 1).Value = 1 'フラグ
                ElseIf mobjWS(0).Cells(1, 1).Value = 1 Then
                    j = j + 2
                End If
                'データの書き出し
                clsData.MoveData2 mobjWS(0), j, i
                '社員情報の取得
                For l = 0 To mlngRow - 1
                    If A(1) = mclsSyain(l).id Then
                        mobjWS(0).Cells(j, 1).Value = mclsSyain(l).Name
                        Exit For
                    End If
                Next
                'メッセージ表示
                If A(2) = 0 Then Me.lblMsg.Caption = "給与" & m + 1 & "/" & n & "処理中..."
                If A(2) = 1 Then Me.lblMsg.Caption = "賞与" & m + 1 & "/" & n & "処理中..."
                DoEvents
                m = m + 1
            'End If
        End If
        i = i + 1
    Loop
    
    'フラグの立てる
    mobjWS(0).Cells(1, 1).Value = 0

    '賞与データの処理
    'i = 1
    'Do Until mobjWS(3).Cells(i, 4).Value = ""
    '    If CDate(mobjWS(3).Cells(i, 4).Value) = datSikyu Then
    '        clsData.GetProperty mobjWS(3), i, A(0), A(1), A(2), A(3), A(4), A(5), A(6), A(7), A(8), A(9), _
    '                        A(10), A(11), A(12), A(13), A(14), A(15), A(16), A(17), A(18), A(19), _
    '                        A(20), A(21), A(22), A(23), A(24)
    '
            '給与データの検査
    '        If A(2) = 1 Then
    '            'カレントレコードの取得
    '            If mobjWS(0).Cells(1, 1).Value = 0 Then
    '                j = 5
    '                mobjWS(0).Cells(1, 1).Value = 1
    '            ElseIf mobjWS(0).Cells(1, 1).Value = 1 Then
    '                j = j + 2
    '            End If
                'データの書き出し
    '            clsData.MoveData2 mobjWS(0), j, i
                '社員情報の取得
    '            For l = 0 To mlngRow - 1
    '                If A(1) = mclsSyain(l).ID Then mobjWS(0).Cells(j, 1).Value = mclsSyain(l).Name
    '            Next
                'メッセージ表示

    '            DoEvents
    '            m = m + 1
    '        End If
    '    End If
    '    i = i + 1
    'Loop
    
    'フラグの立てる
    mobjWS(0).Cells(1, 1).Value = 0
    '配列の開放
    If IsEmpty(A) Then Erase A
    If IsEmpty(B) Then Erase B
    'クラスの開放
    Set clsData = Nothing

    Me.lblMsg.Caption = "終了しました..."
    
End Sub

'社員データの取得
Private Sub GetSyainList()

    Dim i As Long       '長整数型カウンタ
    
    'データ数の取得
    mlngRow = mobjWS(2).Cells(65536, 1).End(xlUp).Row
    '配列再定義
    ReDim mclsSyain(mlngRow - 1) As clsList
    '社員データの取得
    For i = 0 To mlngRow - 1
        'クラスのインスタンス
        Set mclsSyain(i) = New clsList
        mclsSyain(i).GetData mobjWS(2), i + 1, 1, 1, 1
    Next
    
End Sub

'支給年月日取得
Private Sub GetDateList()

    Dim clsDateID As clsList      '支給年月日クラス
    Dim lngRow As Long              'レコード数の取得
    Dim A() As Variant              'データ
    Dim B() As Variant              '変換用データ
    Dim intKisyu As Integer         '期首年
    Dim intTarget As Integer        '対象年
    Dim datTaisyo As Date           '対象月
    Dim datTemp As Date             '一時データ
    Dim i As Long                   '長整数型カウンタ
    Dim j As Long                   '長整数型カウンタ
    Dim k As Long                   '長整数型カウンタ
    
    '期首年月日の取得
    '過去データアクセス許可フラグによる分岐
    If mdlMain.gKakoFlg = False Then intKisyu = Year(CDate(mobjWS(1).Cells(3, 1).Value))
    If mdlMain.gKakoFlg = True Then intKisyu = mdlMain.gYear
    
    'レコード数の取得
    If mobjWS(3).Cells(1, 1).Value = "" Then
        lngRow = 0
    Else
        lngRow = mobjWS(3).Cells(65536, 1).End(xlUp).Row
    End If
    
    If lngRow = 0 Then GoTo ErrorProc
    '支給年月日クラスのインスタンス
    Set clsDateID = New clsList
    
    j = 0
    For i = 0 To lngRow - 1
        clsDateID.GetData2 mobjWS(3), i + 1, 1, 3, -1
        datTaisyo = clsDateID.Hiduke
        intTarget = Year(datTaisyo)
        '支給範囲の検査
        If intTarget = intKisyu Then
            If datTaisyo <> datTemp Then
                j = j + 1
                ReDim Preserve A(1, j - 1) As Variant
                If j > 1 Then
                    For k = 0 To j - 1
                        If A(1, k) <> datTaisyo Then
                            datTemp = datTaisyo
                            A(0, j - 1) = clsDateID.id
                            A(1, j - 1) = clsDateID.Hiduke
                        End If
                    Next
                Else
                    datTemp = datTaisyo
                    A(0, j - 1) = clsDateID.id
                    A(1, j - 1) = clsDateID.Hiduke
                End If
            End If
        End If
    Next
    
    ReDim B(j - 1, 1) As Variant
    
    'データの並び方を変換
    For i = 0 To j - 1
        B(i, 0) = A(0, i)
        B(i, 1) = A(1, i)
    Next
    
    With Me.lstDate
        .Clear
        .ColumnCount = 2
        .List() = B
    End With
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    If IsEmpty(B) = True Then Erase B
    'クラスの開放
    Set clsDateID = Nothing
    
    Exit Sub
    
ErrorProc:

    With Me.lstDate
        .Clear
        .ListIndex = -1
    End With

End Sub

'既定値
Private Sub NewData()

    ReDim mobjWS(3) As Worksheet    'ワークシート
    
    Set mobjWS(0) = ThisWorkbook.Worksheets("Sheet4")
    Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet1")
    Set mobjWS(2) = Workbooks(gstrName).Worksheets("Sheet2")
    Set mobjWS(3) = Workbooks(gstrName).Worksheets("Sheet5")
    
    With Me.lstDate
        .Clear
        .ColumnWidths = "0;72"
        .IMEMode = 3
    End With
    
    '給与賞与データ数の取得
    mlngRow2 = mobjWS(3).Cells(65536, 1).End(xlUp).Row
    
    If Me.lstDate.Enabled = False Then Me.lstDate.Enabled = True
    If Me.cmdOK.Enabled = True Then Me.cmdOK.Enabled = False
    
End Sub