Option Explicit
'金種計算フォーム

Private mobjWS() As Worksheet       'ワークシート
'mobjWS(0)：ThisWorkbook.Sheet7
'mobjWS(1)：Sheet2：社員情報
'mobjWS(2)：Sheet5：給与賞与データ
Private mclsKinsyu() As clsKinsyu   '金種クラス
Private mclsKinsyu2 As clsKinsyu    '入力用金種クラス
Private mclsSyain() As clsList      '社員クラス
Private mclsKyuyo As clsSalary      '給与賞与クラス
Private ma() As Variant             'データ
Private mb() As Variant             'データ
Private mlngKingaku As Long         '金額データ
Private mlngRow1 As Long            '社員データ数
Private mi As Long                  '金種データ数
Private mj As Long                  '入力用金種データ数
Private mFlg As Boolean             '起動の判断----- edit 2004/05/07


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

    '印刷メニューから起動したとき
    If mFlg = True Then Call mdlPrint.PrintKinsyu 'edit 2004/05/07
    Unload Me
    
End Sub

'入力ボタン
Private Sub cmdOK_Click()
        
    If IsNumeric(Me.txtKingaku1.Text) = False Then GoTo ErrorProc
    '配列再定義
    ReDim Preserve ma(10, mj) As Variant
    '金種クラスのインスタンス
    Set mclsKinsyu2 = New clsKinsyu
    
    mlngKingaku = CLng(Me.txtKingaku1.Text)
    mclsKinsyu2.CalculateKinsyu mlngKingaku
    mclsKinsyu2.GetProperty ma(0, mj), ma(1, mj), ma(2, mj), ma(3, mj), ma(4, mj), ma(5, mj), ma(6, mj), _
                            ma(7, mj), ma(8, mj), ma(9, mj), ma(10, mj)
    
    Me.cmdOK.Enabled = False
    Me.cmdSum.Enabled = True
    
    With Me.txtKingaku1
        .Text = ""
        .SetFocus
    End With
    
    mj = UBound(ma, 2) + 1
    
    Exit Sub
    
ErrorProc:

    MsgBox "入力値が不正です。", 16 + 0, "給与計算システム"
    Me.txtKingaku1.SetFocus
    
End Sub

'集計ボタン
Private Sub cmdSum_Click()

    If gFlg = True Then
        Call PrintWorksheet
        gFlg = False
        '印刷メニューより起動の判断のため
        mFlg = True
    ElseIf gFlg = False Then
        Call PrintLabel(mj - 1)
        Me.cmdOK.Enabled = False
    End If
    
    Me.cmdSum.Enabled = False
    
End Sub

'フォーカスが当ったとき
Private Sub txtHani_Enter()

    With Me.txtHani
        .SelStart = 0
        .SelLength = Len(.Text)
        .IMEMode = 3
        .TextAlign = 1
        .BackColor = RGB(255, 255, 0)
    End With
    
End Sub

'フォーカスが外れたとき
Private Sub txtHani_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtHani
        .IMEMode = 0
        .TextAlign = 3
        .BackColor = RGB(255, 255, 255)
    End With
    
    If Me.cmdSum.Enabled = False Then Me.cmdSum.Enabled = True
    Me.cmdSum.SetFocus
    
End Sub

'フォーカスが当ったとき
Private Sub txtKingaku1_Enter()

    With Me.txtKingaku1
        .SelStart = 0
        .SelLength = Len(.Text)
        .IMEMode = 3
        .TextAlign = 1
        .BackColor = RGB(255, 255, 0)
    End With
    
End Sub

'フォーカスが外れたとき
Private Sub txtKingaku1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtKingaku1
        .IMEMode = 0
        .TextAlign = 3
        .BackColor = RGB(255, 255, 255)
    End With
    
End Sub

'キーが押されたとき
Private Sub txtKingaku1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    Me.cmdOK.Enabled = True
    Me.cmdSum.Enabled = False

End Sub

'フォーカスが当ったとき
Private Sub txtKingaku2_Enter()

    With Me.txtKingaku2
        .SelStart = 0
        .SelLength = Len(.Text)
        .IMEMode = 3
        .TextAlign = 3
        .BackColor = RGB(255, 255, 0)
    End With

End Sub

'フォーカスが外れたとき
Private Sub txtKingaku2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    With Me.txtKingaku2
        .IMEMode = 0
        .TextAlign = 3
        .BackColor = RGB(255, 255, 255)
    End With

End Sub

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

    Call NewData
    If gFlg = True Then Call SyainList
    
End Sub

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

    Dim i As Integer    '整数型カウンタ
        
    '配列の開放
    If IsEmpty(ma) = True Then Erase ma
    If IsEmpty(mb) = True Then Erase mb
    
    'クラスの開放
    If gFlg = True Then
        If mi > 0 Then
            For i = 0 To mi - 1
                Set mclsKinsyu(i) = Nothing
            Next
        End If
    ElseIf gFlg = False Then
        Set mclsKinsyu2 = Nothing
    End If
    
    If mlngRow1 > 0 Then
        For i = 0 To mlngRow1 - 1
            Set mclsSyain(i) = Nothing
        Next
    End If
    
    Set mclsKyuyo = Nothing
    
    'オブジェクトの開放
    If gFlg = True Then
        For i = 0 To 2
            Set mobjWS(i) = Nothing
        Next
    End If
    
    If gFlg = True Then Call mdlPrint.PrintKinsyu
    
    gFlg = True
    
End Sub

'進行状況の表示
Private Sub BarPrint(ByVal x As Long, ByVal y As Long)

'引数[x]：総数
'引数[y]：回数

    Const z As Integer = 200               'ラベルの長さ
        
    If x < 1 Or y < 1 Then
        x = 1
        y = 1
    End If
        
    Me.lblBar2.Width = Int(CDbl(z * (y / x)))
    Me.lblMsg.Caption = y & "/" & x & Chr(32) & "処理中..."
    
End Sub

'ワークシートへ書き出し
Private Sub PrintWorksheet()

    Dim intYear As Integer      '対象年
    Dim intTuki As Integer      '対象月
    Dim lngRow1 As Long         '開始レコード
    Dim lngRow2 As Long         '終了レコード
    Dim i As Long               '長整数型カウンタ
    Dim j As Long               '長整数型カウンタ

    lngRow1 = 0 'edit 2004/05/17
    lngRow2 = 0 'edit 2004/05/17
    '対象年月の取得
    intYear = Year(CDate(Me.txtHani.Text))
    intTuki = Month(CDate(Me.txtHani.Text))
    'レコード数の取得
    mi = mobjWS(2).Cells(65536, 1).End(xlUp).Row
    
    For i = 1 To mi
        If Year(CDate(mobjWS(2).Cells(i, 4).Value)) = intYear Then
            If Month(CDate(mobjWS(2).Cells(i, 4).Value)) = intTuki Then
                If lngRow1 = 0 Then lngRow1 = i
                lngRow2 = i
            ElseIf Month(CDate(mobjWS(2).Cells(i, 4).Value)) > intTuki Then
                Exit For
            End If
        End If
    Next
    
    '----- edit 2004/05/24
    '終了レコードがエラーのとき
'    For i = lngRow1 To mi
'        If Year(CDate(mobjWS(2).Cells(i, 4).Value)) = intYear Then
'            'If intTuki = Month(CDate(mobjWS(2).Cells(i, 4).Value)) Then
'            If Month(CDate(mobjWS(2).Cells(i, 4).Value)) = intTuki Then
'                lngRow2 = i
'            ElseIf Month(CDate(mobjWS(2).Cells(i, 4).Value)) = intTuki + 1 Then 'edit 2004/05/17
'                'lngRow2 = i
'                '----- edit 2004/05/17
'                lngRow2 = i - 1
'                Exit For
'                '----- edit 2004/05/17
'        End If
'        '-----edit 2004/05/24
'    Next
    
    If lngRow2 = 0 Then GoTo MonthErrorProc
    '配列再定義
    ReDim mclsKinsyu(lngRow2 - lngRow1) As clsKinsyu
    '給与データの取得
    mi = 0
    For j = lngRow1 To lngRow2
        Call KyuyoData(j)
        Set mclsKinsyu(mi) = New clsKinsyu
        mclsKinsyu(mi).FID = ma(1)
        '-----edit 2004/12/7
        '差引支給額の整数負数を検査
        If CLng(mb(0)) + CLng(mb(2)) - CLng(mb(7)) > 0 Then
            mclsKinsyu(mi).CalculateKinsyu (CLng(mb(0)) + CLng(mb(2))) - CLng(mb(7)) '差引支給額の金種
        Else
            mclsKinsyu(mi).CalculateKinsyu (CLng(0))
        End If
        mclsKinsyu(mi).LetProperty mobjWS(0), mi + 4, 1 'ワークシートへ書き出し
        mi = mi + 1
    Next
    
    '社員名の取得
    For i = 0 To mi - 1
        For j = 0 To mlngRow1 - 1
            If mclsSyain(j).id = mobjWS(0).Cells(i + 4, 1).Value Then
                mobjWS(0).Cells(i + 4, 1).Value = mclsSyain(j).Name
                Exit For
            End If
        Next
        Call BarPrint(mi - 1, i)
        DoEvents
    Next
    
    '合計------ edit 2004/05/08
    Dim tmp() As Long
    ReDim tmp(10) As Long
    Dim k As Integer
    Dim r As Long
    r = mobjWS(0).Cells(65536, 1).End(xlUp).Row
    For k = 0 To 10
        For j = 4 To r
            tmp(k) = tmp(k) + mobjWS(0).Cells(j, k + 2).Value '---- 行指定変更 edit 2004/05/26
            mobjWS(0).Cells(r + 1, k + 2).Value = Format$(tmp(k), "#,##0")
        Next
    Next
    If IsEmpty(tmp) = True Then Erase tmp
    mobjWS(0).Cells(r + 1, 1).Value = "合計"
    '------ edit 2004/05/08
    
    Me.lblMsg.Caption = "終了しました..."
    Me.cmdEnd.Caption = "印刷"
    Exit Sub
    
MonthErrorProc:

    MsgBox "対象となるデータがありません。" & vbCrLf & "再度実行してください。", 64 + 0, "給与計算システム"
    gFlg = False
    Unload Me
    
End Sub

'フォームのラベルに表示
Private Sub PrintLabel(ByVal intNum As Integer)

'引数[intNum]：回数

    Dim objLB As MSForms.Label  'ラベル
    Dim A() As Variant          'データ
    Dim i As Integer            '整数型カウンタ
    Dim j As Integer            '整数型カウンタ
    
    ReDim A(10) As Variant
    '合計
    For i = 0 To 10
        For j = 0 To intNum
            A(i) = A(i) + CLng(ma(i, j))
        Next
    Next
    
    For i = 11 To 20
        Set objLB = Controls("lblYen" & CStr(i))
        objLB.Caption = Format$(A(i - 10), "#,##0")
    Next
    
    With Me.txtKingaku2
        .Text = Format$(A(0), "#,##0")
        .TextAlign = 3
    End With
    
    If IsEmpty(A) = True Then Erase A
    Set objLB = Nothing
    
End Sub

'給与賞与データの取得
Private Sub KyuyoData(ByVal lngRow As Long)

'引数[lngRow]：レコード
    
    '配列再定義
    ReDim ma(24) As Variant
    ReDim mb(7) As Variant
    
    mclsKyuyo.GetProperty mobjWS(2), lngRow, ma(0), ma(1), ma(2), ma(3), ma(4), ma(5), ma(6), ma(7), ma(8), ma(9), ma(10), ma(11), _
                        ma(12), ma(13), ma(14), ma(15), ma(16), ma(17), ma(18), ma(19), ma(20), ma(21), ma(22), ma(23), ma(24)
        
    mclsKyuyo.DataSum mb(0), mb(1), mb(2), mb(3), mb(4), mb(5), mb(6), mb(7)
    
End Sub

'社員リスト取得
Private Sub SyainList()

    Dim lngRow As Long  'レコード
    Dim i As Long       '長整数型カウンタ
    
    mlngRow1 = mobjWS(1).Cells(65536, 1).End(xlUp).Row
    '配列再定義
    ReDim mclsSyain(mlngRow1 - 1) As clsList
    
    For i = 0 To mlngRow1 - 1
        Set mclsSyain(i) = New clsList
        mclsSyain(i).GetData mobjWS(1), i + 1, 1, 1, 1
    Next
    
End Sub

'既定値
Private Sub NewData()

    Dim objLB As MSForms.Label  'ラベル
    Dim i As Integer            '整数型カウンタ
    
    '給与賞与クラスのインスタンス
    Set mclsKyuyo = New clsSalary
    If gFlg = True Then
        '配列再定義
        ReDim mobjWS(2) As Worksheet
        'ワークシート
        Set mobjWS(0) = ThisWorkbook.Worksheets("Sheet9")
        Set mobjWS(1) = Workbooks(gstrName).Worksheets("Sheet2")
        Set mobjWS(2) = Workbooks(gstrName).Worksheets("Sheet5")

        Me.Height = 116
        Me.lblSum.Visible = False
        Me.txtKingaku1.Visible = False
        Me.txtKingaku2.Visible = False
        Me.cmdOK.Enabled = False
        Me.txtHani.Text = Format$(Now(), "yyyy/mm")
        With Me.lblBar2
            .BackColor = RGB(0, 0, 255)
            .Width = 0
        End With
    ElseIf gFlg = False Then
        Me.Height = 168
        Me.lblMsg.Visible = False
        Me.lblBar1.Visible = False
        Me.lblBar2.Visible = False
        Me.txtHani.Visible = False
        Me.lblHani.Visible = False
        With Me.cmdOK
            .Default = True
            .Enabled = False
        End With
        Me.cmdSum.Enabled = False
        Me.txtKingaku2.Locked = True
        'ラベルコントロール
        For i = 1 To 20
            Set objLB = Controls("lblYen" & CStr(i))
            With objLB
                .SpecialEffect = 2
                If i < 11 Then
                    .TextAlign = 2
                    .BackColor = RGB(0, 0, 255)
                    .ForeColor = RGB(255, 255, 255)
                End If
                If i > 10 Then
                    .TextAlign = 3
                    .BackColor = RGB(255, 255, 255)
                    .Caption = ""
                End If
            End With
        Next
        mj = 0
    End If
    
End Sub