End Sub

'*********************************************************************
'*函數(shù)說明: 初始化報(bào)表的 Toolbar                                     *
'*參    數(shù): tlb         Toolbar                                      *
'*          Imag1       ImageList                                    *
'*返回值  :                                                          *
'*********************************************************************
Private Sub REPTlb(tlb As ToolBar, Img1 As ImageList)
    Dim imgt As ListImage
    Dim id As Integer
    Set imgt = Img1.ListImages.Add(, "Set", LoadResPicture(307, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "Print", LoadResPicture(314, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "Preview", LoadResPicture(312, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "BatchPrn", LoadResPicture(313, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "Seek", LoadResPicture(331, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "Modify", LoadResPicture(324, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "Save", LoadResPicture(1145, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "PriorPage", LoadResPicture(1139, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "NextPage", LoadResPicture(1133, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "FirstPage", LoadResPicture(1174, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "LastPage", LoadResPicture(1117, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "Help", LoadResPicture(396, vbResBitmap))
    Set imgt = Img1.ListImages.Add(, "exit", LoadResPicture(1118, vbResBitmap))
    With tlb
        .Buttons("Set").Image = "Set"
        .Buttons("Set").ToolTipText = "Ctrl+W"
        .Buttons("Print").Image = "Print"
        .Buttons("Print").ToolTipText = "Ctrl+P"
        .Buttons("Preview").Image = "Preview"
'        .Buttons("Preview").ToolTipText = "Ctrl+S" 'cuidong 2001.01.15
        .Buttons("Preview").ToolTipText = ""        'cuidong 2001.01.15
        .Buttons("BatchPrn").Image = "BatchPrn"
        .Buttons("BatchPrn").ToolTipText = "Ctrl+B"
        .Buttons("Seek").Image = "Seek"
        .Buttons("Seek").ToolTipText = "Ctrl+C"
        .Buttons("Modify").Image = "Modify"
        .Buttons("Modify").ToolTipText = "Ctrl+M"
        .Buttons("Save").Image = "Save"
        .Buttons("Save").ToolTipText = "Ctrl+A"
        .Buttons("PriorPage").Image = "PriorPage"
        .Buttons("PriorPage").ToolTipText = "Ctrl+PageUp"
        .Buttons("NextPage").Image = "NextPage"
        .Buttons("NextPage").ToolTipText = "Ctrl+PageDown"
        .Buttons("FirstPage").Image = "FirstPage"
        .Buttons("FirstPage").ToolTipText = "Ctrl+HomePage"
        .Buttons("LastPage").Image = "LastPage"
        .Buttons("LastPage").ToolTipText = "Ctrl+EndPage"
        .Buttons("Help").Image = "Help"
        .Buttons("Help").ToolTipText = "F1"
        .Buttons("exit").Image = "exit"
        .Buttons("exit").ToolTipText = "Alt+F4"
    End With
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF4
            If Shift = 2 Then
                Gen_Key "Exit"
            End If
        Case vbKeyP
            If Shift = 2 Then
                Gen_Key "Print"
            End If
        Case vbKeyS
            'cuidong 2001.01.15
            'If Shift = 2 Then
            '    Gen_Key "Preview"
            'End If
        Case vbKeyW
            If Shift = 2 Then
                Gen_Key "Set"
            End If
        Case vbKeyA
            If Shift = 2 Then
                Gen_Key "Save"
            End If
        Case vbKeyHome
            If Shift = 2 Then
                Gen_Key "FirstPage"
            End If
        Case vbKeyEnd
            If Shift = 2 Then
                Gen_Key "LastPage"
            End If
        Case vbKeyPageUp
            If Shift = 2 Then
                Gen_Key "PriorPage"
            End If
        Case vbKeyPageDown
            If Shift = 2 Then
                Gen_Key "NextPage"
            End If
        Case vbKeyM
            If Shift = 2 Then
                Gen_Key "Modify"
            End If
        Case vbKeyB
            If Shift = 2 Then
                Gen_Key "BatchPrn"
            End If
        Case vbKeyC
            If Shift = 2 Then
                Gen_Key "Seek"
            End If
            
    End Select
End Sub

Private Sub IniTxt()
    If rstLXadv.RecordCount = 0 Then
        txtUtName = ""
        txtAccID = ""
        txtChkCode = ""
        txtBillCode = ""
    End If
    
End Sub
'是否存盤
Private Sub SaveYN()
    Dim i
    Dim scAccID     As String
    Dim sDbill_date As String
    Dim sdFrom      As String
    Dim sdTo        As String
    
    scAccID = rstLXadv![cAccId]
    sDbill_date = ForDate(rstLXadv![JCR])
    sdFrom = ForDate(rstLXadv![dFrom])
    sdTo = ForDate(rstLXadv![dTo])
    
    i = MsgBox("是否保存已修改的記錄?", vbQuestion + vbOKCancel, zjGl_Name)
    If i = vbOK Then
        If edtRemark = "" Then
            dbsZJ.Execute "UPDATE FD_CadAcr SET FD_CadAcr.cRemark=Null " & _
                        "WHERE (FD_CadAcr.cGAccID='" & scAccID & "' OR FD_CadAcr.cPAccID" & _
                        "='" & scAccID & "') AND FD_CadAcr.dbill_date='" & sDbill_date & "'" _
                        & " AND FD_CadAcr.dFrom='" & sdFrom & "' AND FD_CadAcr.dTo='" & sdTo & _
                        "'", dbFailOnError
        Else
            dbsZJ.Execute "UPDATE FD_CadAcr SET FD_CadAcr.cRemark='" & edtRemark & _
                        "' WHERE (FD_CadAcr.cGAccID='" & scAccID & "' OR FD_CadAcr.cPAccID" & _
                        "='" & scAccID & "') AND FD_CadAcr.dbill_date='" & sDbill_date & "'" _
                        & " AND FD_CadAcr.dFrom='" & sdFrom & "' AND FD_CadAcr.dTo='" & sdTo & _
                        "'", dbFailOnError
        End If
        rstLXadv.Requery
    End If
    edtRemark.Locked = True
    bSave = False
        
End Sub

'初始化查詢條件
Public Sub IniSQL()
    edtRemark.Locked = True
    
'    DisplayDate
    
'    sSql1 = "SELECT FD_AccUnit.cUnitName AS UnitName, FD_AccDef.cAccID " & _
            "AS cAccID, FD_CadAcr.dbill_date AS JCR,FD_CadAcr.dFrom,FD_CadAcr.dTo," & _
            " FD_CadAcr.cBillCode AS ZDR, FD_AccSum.mh_Cad AS JS,SUM(FD_CadAcr.mmoney) AS LXE, " & _
            "FD_CadAcr.cRemark AS BZ, FD_CadAcr.cCheckCode AS FH" & _
            " FROM FD_Intras INNER JOIN (FD_CadAcr INNER JOIN " & _
            "(FD_AccSum INNER JOIN (FD_AccDef INNER JOIN FD_AccUnit ON " & _
            "FD_AccDef.cUnitCode=FD_AccUnit.cUnitCode) ON FD_AccSum.cAccID=FD_AccDef.cAccID) ON " & _
            "FD_CadAcr.dbill_date=FD_AccSum.dbill_date+1) ON FD_Intras.cIntrID=FD_CadAcr.cIntrID " & _
            "WHERE FD_CadAcr.iDanType=0 and FD_CadAcr.cDanID is null and (FD_CadAcr.cPAccID=FD_AccDef.cAccID OR FD_CadAcr.cGAccID=FD_AccDef.cAccID) " 'cuidong Lxd/2 2002.03.18
    
    sSql1 = "SELECT FD_AccUnit.cUnitName AS UnitName, FD_AccDef.cAccID " & _
            "AS cAccID, FD_CadAcr.dbill_date AS JCR,FD_CadAcr.dFrom,FD_CadAcr.dTo," & _
            " FD_CadAcr.cBillCode AS ZDR, FD_AccSum.mh_Cad AS JS,SUM(FD_CadAcr.mmoney) AS LXE, " & _
            "FD_CadAcr.cRemark AS BZ, FD_CadAcr.cCheckCode AS FH" & _
            " FROM FD_Intra INNER JOIN (FD_CadAcr INNER JOIN " & _
            "(FD_AccSum INNER JOIN (FD_AccDef INNER JOIN FD_AccUnit ON " & _
            "FD_AccDef.cUnitCode=FD_AccUnit.cUnitCode) ON FD_AccSum.cAccID=FD_AccDef.cAccID) ON " & _
            "FD_CadAcr.dbill_date=FD_AccSum.dbill_date+1) ON FD_Intra.cIntrID=FD_CadAcr.cIntrID " & _
            "WHERE FD_CadAcr.iDanType=0 and FD_CadAcr.cDanID is null and (FD_CadAcr.cPAccID=FD_AccDef.cAccID OR FD_CadAcr.cGAccID=FD_AccDef.cAccID) " 'cuidong Lxd/2 2002.03.18

    sSql2 = " GROUP BY FD_AccDef.cAccID, FD_AccUnit.cUnitName," & _
            "FD_CadAcr.dbill_date, FD_CadAcr.cBillCode, FD_AccSum.mh_Cad, " & _
            "FD_CadAcr.cRemark, FD_CadAcr.cCheckCode, FD_CadAcr.cBillCode," & _
            "FD_CadAcr.dFrom,FD_CadAcr.dTo"
            
    '生成查詢語句
    With Me:
        .sDateStart = ForDate(.sDateStart)
        .sDateEnd = ForDate(.sDateEnd)
        If .sDateStart = "" And .sDateEnd <> "" Then
            .edtEnd = .sDateEnd
            If .sDW = "" And .sZH = "" Then
                sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateEnd) & "'"
            ElseIf .sDW = "" And .sZH <> "" Then
                sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateEnd) & _
                    "' AND FD_AccDef.cAccID='" & .sZH & "'"
            ElseIf .sDW <> "" And .sZH = "" Then
                sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateEnd) & _
                    "' AND FD_AccUnit.cUnitName='" & .sDW & "'"
            ElseIf .sDW <> "" And .sZH <> "" Then
                sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateEnd) & _
                    "' AND FD_AccUnit.cUnitName='" & .sDW & "'"   'ADD a Clause of edtZH
            End If
        ElseIf .sDateStart <> "" And .sDateEnd = "" Then
            frmtzdPrn.edtStart = .sDateStart
            If .sDW = "" And .sZH = "" Then
                sSQL = "AND FD_CadAcr.dbill_date>='" & Trim(.sDateStart) & "'"
            ElseIf .sDW = "" And .sZH <> "" Then
                sSQL = "AND FD_CadAcr.dbill_date>='" & Trim(.sDateStart) & _
                    "' AND FD_AccDef.cAccID='" & .sZH & "'"
            ElseIf .sDW <> "" And .sZH = "" Then
                sSQL = "AND FD_CadAcr.dbill_date>='" & Trim(.sDateStart) & _
                    "' AND FD_AccUnit.cUnitName='" & .sDW & "'"
            ElseIf .sDW <> "" And .sZH <> "" Then
                sSQL = "AND FD_CadAcr.dbill_date>='" & Trim(.sDateStart) & _
                    "' AND FD_AccUnit.cUnitName='" & .sDW & "'"  'ADD a Clause of edtZH
            End If
        ElseIf .sDateStart = "" And .sDateEnd = "" Then
            frmtzdPrn.edtStart = "": frmtzdPrn.edtEnd = ""
            If .sDW = "" And .sZH = "" Then
                sSQL = ""
            ElseIf .sDW = "" And .sZH <> "" Then
                sSQL = "AND FD_AccDef.cAccID='" & Trim(.sZH) & "'"
            ElseIf .sDW <> "" And .sZH = "" Then
                sSQL = "AND FD_AccUnit.cUnitName='" & .sDW & "'"
            ElseIf .sDW <> "" And .sZH <> "" Then
                sSQL = "AND FD_AccUnit.cUnitName='" & .sDW & "'" 'ADD a Clause of edtZH
            End If
        ElseIf .sDateStart <> "" And .sDateEnd <> "" Then
            frmtzdPrn.edtStart = .sDateStart: frmtzdPrn.edtEnd = .sDateEnd
            If CDate(frmtzdPrn.edtStart) = CDate(frmtzdPrn.edtEnd) Then
                If .sDW = "" And .sZH = "" Then
                    sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateStart) & "'"
                ElseIf .sDW = "" And .sZH <> "" Then
                    sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateStart) & _
                        "' AND FD_AccDef.cAccID='" & Trim(.sZH) & "'"
                ElseIf .sDW <> "" And .sZH = "" Then
                    sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateStart) & _
                        "' AND FD_AccUnit.cUnitName='" & .sDW & "'"
                ElseIf .sDW <> "" And .sZH <> "" Then
                    sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateStart) & _
                        "' AND FD_AccUnit.cUnitName='" & .sDW & "'" 'ADD a Clause of edtZH
                End If
            Else
                If .sDW = "" And .sZH = "" Then
                    sSQL = "AND FD_CadAcr.dbill_date BETWEEN '" & Trim(.sDateStart) & _
                        "' AND '" & Trim(.sDateEnd) & "'"
                ElseIf .sDW = "" And .sZH <> "" Then
                    sSQL = "AND FD_CadAcr.dbill_date BETWEEN '" & Trim(.sDateStart) & _
                        "' AND '" & Trim(.sDateEnd) & "' AND FD_AccDef.cAccID='" & _
                        Trim(.sZH) & "'"
                ElseIf .sDW <> "" And .sZH = "" Then
                    sSQL = "AND FD_CadAcr.dbill_date BETWEEN '" & Trim(.sDateStart) & _
                        "' AND '" & Trim(.sDateEnd) & "' AND FD_AccUnit.cUnitName='" & _
                        Trim(.sDW) & "'"
                ElseIf .sDW <> "" And .sZH <> "" Then
                    sSQL = "AND FD_CadAcr.dbill_date BETWEEN '" & Trim(.sDateStart) & _
                        "' AND '" & Trim(.sDateEnd) & "' AND FD_AccUnit.cUnitName='" & _
                        Trim(.sDW) & "'"
                End If                      'ADD a Clause of edtZH
            End If
        End If
    End With
    
    If blnPrn Then
        sSQL = sSql1 & sSQL & " AND (" & prnAccID & ")" & sSql2
    Else
        sSQL = sSql1 & sSQL & sSql2
    End If
    
    Set rstLXadv = dbsZJ.OpenRecordset(sSQL, dbOpenDynaset)
    IniTxt
    FrmRefresh
    SetButtonStatus
    Screen.MousePointer = vbDefault

End Sub
'取選定的打印賬戶
Private Sub tzdPrns_ReturnAccID(blnPrint As Boolean)
    Dim i As Integer, str As String
    
    prnAccID = ""
    If blnPrint And tzdPrns.List1(2).ListCount > 0 Then
       With tzdPrns
          For i = 0 To .List1(2).ListCount - 1
             str = .List1(2).List(i)
             prnAccID = prnAccID & " FD_AccDef.cAccID='" & str & "' OR"
          Next i
       End With
    Else
        prnAccID = ""
    End If
    If prnAccID <> "" Then prnAccID = left(prnAccID, Len(prnAccID) - 2)
    blnPrn = blnPrint

End Sub

Private Sub ReSetForm()
    edtStart = ""
    edtEnd = ""
    edtDays = ""
    edtSum = ""
    edtInter = ""
    txtRate = ""
    edtRemark = ""
    
End Sub