Option Explicit
'支払明細書印刷フォーム

Private mobjWS() As Worksheet   'ワークシート
'mobjWS(0)：支給明細書
'mobjWS(1)：社員情報
'mobjWS(2)：給与賞与データ
'mobjWS(3)：基礎データ
Private mlngPID As Long             '給与賞与ID
Private mlngFID As Long             '社員ID
Private mlngKubun As Long           '給与賞与区分
Private mclsSyainID() As clsList    '社員クラス
Private mlngRow As Long             '社員数

'印刷ボタン
Private Sub cmdOK_Click()
    
    '社員選択
    mlngKubun = Me.lstDate.List(Me.lstDate.ListIndex, 2)
    mlngPID = Me.lstDate.List(Me.lstDate.ListIndex, 0)
    Call DataMove
    Call mdlPrint.PrintMeisaisyo
    Me.lstDate.Clear
    Me.cmdOK.Enabled = False
        
End Sub

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

    Unload Me
    
End Sub

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

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

'社員リスト選択
Private Sub lstSyain_Click()

    On Error GoTo DateErrorProc
    mlngFID = CLng(Me.lstSyain.List(Me.lstSyain.ListIndex, 0))
    Call GetDateList
    If Me.lstDate.Enabled = False Then Me.lstDate.Enabled = True
    Exit Sub
    
DateErrorProc:

    MsgBox "支給実績がありません。" & vbCrLf & "確認して下さい。", 16 + 0, "給与計算システム"
    
End Sub

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

    Call NewData
    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 mclsSyainID(i) = Nothing
    Next
    'オブジェクトの開放
    For i = 0 To 3
        Set mobjWS(i) = Nothing
    Next
    
End Sub

'印刷用データの移動
Private Sub DataMove()

    Dim clsData As clsSalary    '給与賞与クラス
    Dim A() As Variant          'データ
    Dim B() As Variant          'クラスのプロパティ
    Dim c() As Variant          '項目データ
    Dim lngRow As Long          'レコード
    Dim i As Long               '長整数型カウンタ
    Dim j As Long               '長整数型カウンタ
    
    '配列再定義
    ReDim A(7) As Variant
    ReDim B(24) As Variant
    ReDim c(8) As Variant
    
    '定義項目をセット
    If mlngKubun = 0 Then
        For i = 1 To 9
            c(i - 1) = mobjWS(3).Cells(4, i).Value
        Next
        For i = 7 To 15
            If i < 12 Then mobjWS(0).Cells(5, i).Value = c(i - 7)
            If i > 11 Then mobjWS(0).Cells(8, i - 6).Value = c(i - 7)
        Next
    ElseIf mlngKubun = 1 Then
        For i = 1 To 3
            c(i - 1) = mobjWS(3).Cells(5, i).Value
        Next
        For i = 6 To 8
            mobjWS(0).Cells(8, i).Value = c(i - 1)
        Next
    End If
        
    'クラスのインスタンス
    Set clsData = New clsSalary
    'レコード数の取得
    lngRow = mobjWS(2).Cells(65536, 1).End(xlUp).Row
    '目的のデータの検索
    For i = 1 To lngRow
        If mlngPID = CLng(mobjWS(2).Cells(i, 1).Value) Then
            If mlngFID = CLng(mobjWS(2).Cells(i, 2).Value) Then
                clsData.GetProperty mobjWS(2), i, B(0), B(1), B(2), B(3), B(4), B(5), B(6), B(7), B(8), B(9), B(10), B(11), _
                                B(12), B(13), B(14), B(15), B(16), B(17), B(18), B(19), B(20), B(21), B(22), B(23), B(24)
            
                clsData.MoveData3 mobjWS(0)
                clsData.DataSum A(0), A(1), A(2), A(3), A(4), A(5), A(6), A(7)
            
                mobjWS(0).Cells(12, 1).Value = Format$(A(0), "#,##0")
                mobjWS(0).Cells(12, 3).Value = Format$(A(2), "#,##0")
                mobjWS(0).Cells(12, 5).Value = Format$(A(0) + A(2), "#,##0")
                mobjWS(0).Cells(15, 1).Value = Format$(A(3), "#,##0")
                mobjWS(0).Cells(15, 3).Value = Format$(A(4), "#,##0")
                mobjWS(0).Cells(15, 5).Value = Format$(A(5), "#,##0")
                mobjWS(0).Cells(15, 7).Value = Format$(A(6), "#,##0")
                mobjWS(0).Cells(15, 9).Value = Format$(A(1), "#,##0")
                mobjWS(0).Cells(6, 13).Value = Format$(A(0) + A(2), "#,##0")
                mobjWS(0).Cells(9, 10).Value = Format$(A(7), "#,##0")
                mobjWS(0).Cells(15, 11).Value = Format$(A(1) + A(3) + A(4) + A(5) + A(6), "#,##0")
                mobjWS(0).Cells(18, 1).Value = Format$((A(0) + A(2)) - A(7), "#,##0")
                '社員情報の取得
                For j = 0 To mlngRow - 1
                    If mlngFID = mclsSyainID(j).id Then
                        mobjWS(0).Cells(3, 2).Value = mclsSyainID(j).Name
                        Exit For
                    End If
                Next
                Exit For
            End If
        End If
    Next
    
    '事業所名を書き込み
    mobjWS(0).Cells(18, 9).Value = mobjWS(3).Cells(6, 1).Value
    '支給日を書き込み
    mobjWS(0).Cells(3, 6).Value = Format$(Me.lstDate.List(Me.lstDate.ListIndex, 1), "yyyy/mm/dd")
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    If IsEmpty(B) = True Then Erase B
    'クラスの開放
    Set clsData = Nothing
    
End Sub

'社員リストの取得
Private Sub GetSyainList()
    
    Dim A() As Variant              'データ
    Dim i As Long                   '長整数型カウンタ
    
    'レコード
    If mobjWS(1).Cells(1, 1).Value = "" Then
        mlngRow = 0
    Else
        mlngRow = mobjWS(1).Cells(65536, 1).End(xlUp).Row
    End If
    
    If mlngRow = 0 Then Exit Sub
    
    ReDim mclsSyainID(mlngRow - 1) As clsList   'クラス再定義
    ReDim A(mlngRow - 1, 1) As Variant          '配列再定義
    
    For i = 0 To mlngRow - 1
        '社員リストクラスのインスタンス
        Set mclsSyainID(i) = New clsList
        
        '社員リストの取得
        mclsSyainID(i).GetData mobjWS(1), i + 1, 1, 1, 4
        
        '配列に格納
        A(i, 0) = mclsSyainID(i).id
        A(i, 1) = mclsSyainID(i).Name
    Next
    
    With Me.lstSyain
        .Clear
        .ColumnCount = 2
        .List() = A
    End With
    
    If IsEmpty(A) = True Then Erase A
    
End Sub

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

    Dim clsDateID As clsList      '支給年月日クラス
    Dim lngRow As Long              'レコード数の取得
    Dim A() As Variant              'データ
    Dim intKisyu As Integer         '期首年
    Dim intTarget As Integer        '対象年
    Dim i As Long                   '長整数型カウンタ
    Dim j As Long                   '長整数型カウンタ
    
    '期首年月日の取得
    intKisyu = Year(CDate(mobjWS(3).Cells(3, 1).Value))
    'レコード数の取得
    lngRow = mobjWS(2).Cells(65536, 1).End(xlUp).Row
    j = 0
    For i = 0 To lngRow - 1
        intTarget = Year(CDate(mobjWS(2).Cells(i + 1, 4).Value))
        '支給範囲の検査
        If intTarget = intKisyu Then
            If mlngFID = CLng(mobjWS(2).Cells(i + 1, 2).Value) Then
                j = j + 1
            End If
        End If
    Next
    
    ReDim A(j - 1, 2) As Variant '配列再定義
    '支給年月日クラスのインスタンス
    Set clsDateID = New clsList
    j = 0
    For i = 0 To lngRow - 1
        intTarget = Year(CDate(mobjWS(2).Cells(i + 1, 4).Value))
        '支給範囲の検査
        If intTarget = intKisyu Then
            If mlngFID = CLng(mobjWS(2).Cells(i + 1, 2).Value) Then
                clsDateID.GetData2 mobjWS(2), i + 1, 1, 3, -1
                '配列に格納
                A(j, 0) = clsDateID.id
                A(j, 1) = Format$(clsDateID.Hiduke, "yyyy/mm/dd")
                A(j, 2) = clsDateID.Number
                j = j + 1
            End If
        End If
    Next

    With Me.lstDate
        .Clear
        .ColumnCount = 3
        .List() = A
    End With
    
    '配列の開放
    If IsEmpty(A) = True Then Erase A
    'クラスの開放
    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("Sheet8")
    Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet2")
    Set mobjWS(2) = Workbooks(gstrName).Worksheets("Sheet5")
    Set mobjWS(3) = Workbooks(gstrName).Worksheets("Sheet1")
    
    '社員リスト
    With Me.lstSyain
        .Clear
        .ColumnWidths = "0;72"
    End With
    '支給日リスト
    With Me.lstDate
        .Clear
        .ColumnWidths = "0;72;5"
        .Enabled = False
    End With
    
    With Me.lblMsg
        .Caption = vbCrLf & "支給日の右の数字" & vbCrLf & "[0]:給与" & vbCrLf & "[1]:賞与"
        .BackColor = RGB(255, 255, 0)
    End With
    
    'コマンドボタン
    If Me.cmdOK.Enabled = True Then Me.cmdOK.Enabled = False
    
End Sub