利息通知单批打印.frm

u8

                While List1(0).ListCount > 0
                    If List1(0).ListIndex <> -1 Then
                        If List1(0).Selected(List1(0).ListIndex) Then
                            List1(1).AddItem List1(0).Text
                            sUnitName = List1(0).Text
                            sSqltmp = "AND FD_AccUnit.cUnitName='" & sUnitName & "'"
                            AccIDInfo sSqltmp, List1(2)
                            List1(0).RemoveItem List1(0).ListIndex
                        End If
                    Else
                        SelectItem
                        Exit Sub
                    End If
                Wend
            End If
        Case 3:
            iButtonNum = 3
            If List1(1).ListCount > 0 Then
                While List1(1).ListCount > 0
                    If List1(1).ListIndex <> -1 Then
                        If List1(1).Selected(List1(1).ListIndex) Then
                            List1(0).AddItem List1(1).Text
                            sUnitName = List1(1).Text
                            RemoveItemOutList (sUnitName)
                            List1(1).RemoveItem List1(1).ListIndex
                            SelectItem
                            Exit Sub
                        End If
                    Else
                        Exit Sub
                    End If
                Wend
            End If
        Case 4:
            iButtonNum = 4
            If List1(3).ListCount > 0 Then
                While List1(3).ListCount > 0
                    List1(3).Selected(0) = True
                    If List1(3).Selected(List1(3).ListIndex) Then
                        List1(2).AddItem List1(3).Text
                        List1(3).RemoveItem List1(3).ListIndex
                    End If
                Wend
            End If
        Case 5:
            iButtonNum = 5
            If List1(2).ListCount > 0 Then
                While List1(2).ListCount > 0
                    List1(2).Selected(0) = True
                    If List1(2).Selected(List1(2).ListIndex) Then
                        List1(3).AddItem List1(2).Text
                        List1(2).RemoveItem List1(2).ListIndex
                    End If
                Wend
            End If
        Case 6:
            iButtonNum = 6
            If List1(3).ListCount > 0 Then
                While List1(3).ListCount > 0
                    If List1(3).ListIndex <> -1 Then
                        If List1(3).Selected(List1(3).ListIndex) Then
                            List1(2).AddItem List1(3).Text
                            List1(3).RemoveItem List1(3).ListIndex
                        End If
                    Else
                        SelectItem
                        Exit Sub
                    End If
                Wend
            End If
        Case 7:
            iButtonNum = 7
            If List1(2).ListCount > 0 Then
                While List1(2).ListCount > 0
                    If List1(2).ListIndex <> -1 Then
                        If List1(2).Selected(List1(2).ListIndex) Then
                            List1(3).AddItem List1(2).Text
                            List1(2).RemoveItem List1(2).ListIndex
                        End If
                    Else
                        SelectItem
                        Exit Sub
                    End If
                Wend
            End If
    End Select
    SelectItem
    
End Sub
'添加账号到列表框
Private Sub AddItemIntoList(DWName As String)
    Dim sSQL   As String
    Dim rstZH  As New UfRecordset
        
    Select Case iButtonNum
        Case 0:
            If List1(0).ListCount > 0 Then
                List1(0).Selected(0) = True
                While List1(0).ListIndex <= List1(0).ListCount - 1
                    List1(1).AddItem List1(0).Text
                    If List1(0).ListIndex + 1 = List1(0).ListCount Then
                        List1(0).Clear
                        Exit Sub
                    End If
                    List1(0).Selected(List1(0).ListIndex + 1) = True
                Wend

                sSQL = "SELECT DISTINCT FD_AccDef.cAccID FROM FD_AccDef INNER JOIN FD_AccUnit " & _
                    "ON FD_AccDef.cUnitCode = FD_AccUnit.cUnitCode WHERE "
                List1(0).Selected(0) = True
                While List1(0).ListIndex < List1(0).ListCount - 1
                    If List1(0).ListIndex = 0 Then
                        sSQL = sSQL & "FD_AccUnit.cUnitName='" & List1(0).Text & "'"
                    Else
                        sSQL = sSQL & " OR FD_AccUnit.cUnitName='" & List1(0).Text & "'"
                    End If
                    List1(0).Selected(List1(0).ListIndex + 1) = True
                Wend
            End If
        Case 2
            sSQL = "SELECT DISTINCT FD_AccDef.cAccID FROM FD_AccDef INNER JOIN FD_AccUnit " & _
                "ON FD_AccDef.cUnitCode = FD_AccUnit.cUnitCode WHERE FD_AccUnit.cUnitName='" & DWName & "'"
    
    End Select
            Set rstZH = dbsZJ.OpenRecordset(sSQL, dbOpenSnapshot)
            
            With rstZH
                On Error Resume Next
                .MoveFirst
                On Error GoTo 0
                While Not .EOF
                    List1(2).AddItem ![cAccID]
                    .MoveNext
                Wend
            End With
            
            rstZH.oClose
            Set rstZH = Nothing

End Sub
'移除账号
Private Sub RemoveItemOutList(DWName As String)
    Dim sSQL     As String
    Dim sSql1    As String
    Dim rstZH    As New UfRecordset
    
    Select Case iButtonNum
        Case 1:
            If List1(1).ListCount > 0 Then
                While List1(1).ListIndex < List1(1).ListCount - 1
                    List1(0).AddItem List1(1).Text
                    List1(1).Selected(List1(1).ListIndex + 1) = True
                Wend
                List1(1).Clear
            End If
        Case 3:
            sSQL = "SELECT DISTINCT FD_AccUnit.cUnitName AS UnitName, FD_AccDef.cAccID AS cAccID " & _
                "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-1=FD_AccSum.dbill_date) " & _
                "ON FD_Intras.cIntrID=FD_CadAcr.cIntrID Where " & _
                "FD_CadAcr.cGAccID = FD_AccDef.cAccID AND FD_AccUnit.cUnitName='" & DWName & "'"
            sSql1 = " GROUP BY FD_AccUnit.cUnitName,FD_AccDef.cAccID"
            
            Set rstZH = dbsZJ.OpenRecordset(sSQL & sSql1, dbOpenSnapshot)
            iNum = 0
            
'判断在被选定打印的账户中是否有要移除的账户
            With rstZH
                On Error Resume Next
                .MoveFirst
                On Error GoTo 0
                While Not .EOF
                    If List1(2).ListCount > 0 Then List1(2).Selected(0) = True
                    While List1(2).ListIndex < List1(2).ListCount
                        If ![cAccID] = List1(2).Text Then
                            List1(2).RemoveItem List1(2).ListIndex
                            iNum = iNum + 1
                            GoTo MoveRow
                        Else
                            If List1(2).ListIndex + 1 <= List1(2).ListCount - 1 Then
                                List1(2).Selected(List1(2).ListIndex + 1) = True
                            Else
                                GoTo MoveRow
                            End If
                        End If
                    Wend
MoveRow:
                    .MoveNext
                Wend
            End With
            
'判断在未被选定打印的账户中是否有要移除的账户
            If iNum <> rstZH.RecordCount Then
                With rstZH
                    On Error Resume Next
                    .MoveFirst
                    On Error GoTo 0
                    While Not .EOF
                        If List1(3).ListCount > 0 Then List1(3).Selected(0) = True
                        While List1(3).ListIndex < List1(3).ListCount
                            If ![cAccID] = List1(3).Text Then
                                List1(3).RemoveItem List1(3).ListIndex
                                iNum = iNum + 1
                                GoTo MoveRow1
                            Else
                                If List1(3).ListIndex + 1 <= List1(3).ListCount - 1 Then
                                    List1(3).Selected(List1(3).ListIndex + 1) = True
                                Else
                                    GoTo MoveRow1
                                End If
                            End If
                        Wend
MoveRow1:
                        .MoveNext
                    Wend
                End With
                
            End If

            rstZH.oClose
            Set rstZH = Nothing
    End Select
   
End Sub
'刷新账户信息
Private Sub AccIDInfo(SQLstr As String, ctrList As ListBox, Optional ButtonIndex As Integer = 100)
    Dim sSQL        As String
    Dim sSql1       As String
    Dim sSql2       As String
    Dim sSql3       As String
    Dim rstAcctmp   As New UfRecordset
    
    sSQL = "SELECT DISTINCT FD_AccUnit.cUnitName AS UnitName, FD_AccDef.cAccID AS cAccID " & _
        "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-1=FD_AccSum.dbill_date) " & _
        "ON FD_Intras.cIntrID=FD_CadAcr.cIntrID Where  " & _
        "FD_CadAcr.cGAccID = FD_AccDef.cAccID "
    sSql1 = " GROUP BY FD_AccUnit.cUnitName,FD_AccDef.cAccID"
    sSql2 = "SELECT DISTINCT FD_AccUnit.cUnitName AS UnitName " & _
        "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-1=FD_AccSum.dbill_date) " & _
        "ON FD_Intras.cIntrID=FD_CadAcr.cIntrID Where " & _
        "FD_CadAcr.cGAccID = FD_AccDef.cAccID "
    sSql3 = " GROUP BY FD_AccUnit.cUnitName"

    If SQLstr = "" Then
        sSQL = sSQL & sSql1
    Else
        sSQL = sSQL & SQLstr & sSql1
    End If
    
    Select Case ButtonIndex
        Case 0:
            Set rstAcctmp = dbsZJ.OpenRecordset(sSql2 & SQLstr & sSql3, dbOpenSnapshot)
            With rstAcctmp:
                While Not .EOF
                    ctrList.AddItem ![UnitName]
                    .MoveNext
                Wend
            End With
        Case 3:
            Set rstAcctmp = dbsZJ.OpenRecordset(sSql2 & SQLstr & sSql3, dbOpenSnapshot)
            With rstAcctmp:
                While Not .EOF
                    ctrList.AddItem ![UnitName]
                    .MoveNext
                Wend
            End With
        Case Else
            Set rstAcctmp = dbsZJ.OpenRecordset(sSQL, dbOpenSnapshot)
            With rstAcctmp:
                While Not .EOF
                    ctrList.AddItem ![cAccID]
                    .MoveNext
                Wend
            End With
        
    End Select
    
    rstAcctmp.oClose
    Set rstAcctmp = Nothing
    
End Sub
'取ListBox选中的项目
Private Sub GetAccID()
    Dim i As Integer
    s = ""
    For i = 0 To List1(2).ListCount - 1
        s = s & " FD_AccDef.cAccID='" & List1(2).List(i) & "' OR"
    Next i
    If s <> "" Then s = Left(s, Len(s) - 2)
End Sub
'设置ListBox默认选项
Private Sub SelectItem()
    Dim i As Integer
    For i = 0 To 3
        If List1(i).ListCount <> 0 Then List1(i).Selected(0) = True
    Next i
    
End Sub

Private Sub List1_dblClick(Index As Integer)
    Select Case Index
        Case 0:
            Command1_Click (2)
        Case 1:
            Command1_Click (3)
        Case 2:
            Command1_Click (7)
        Case 3:
            Command1_Click (6)
    End Select
    
End Sub
'比较列表项
Private Sub Comparelst23()
    Dim i, j As Integer
    With List1(2):
        For i = 0 To .ListCount - 1
            With List1(3)
                For j = 0 To .ListCount - 1
                    If .List(j) = List1(2).List(i) Then
                        List1(2).RemoveItem i
                    End If
                Next j
            End With
        Next i
    End With
End Sub