form5.frm

民间标会的会员管理用的软件。是为一个顾客定做的！

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit


Private Sub cboND_Click()
Dim NN As Integer

NN = GetMonthNo(Date) + 1



If cboND.Text = Year(Now) Then
    AddToList "SELECT * FROM 月份表 WHERE 月份编号<=" & NN, cboYf
     cboYf.ListIndex = cboYf.ListCount - 1
ElseIf cboND.Text = Year(Now) - 5 Then
    
    AddToList "SELECT * FROM 月份表 WHERE 月份编号>" & NN, cboYf
    cboYf.ListIndex = 0
Else
    AddToList "SELECT * FROM 月份表", cboYf
    cboYf.ListIndex = 0
End If

End Sub

Private Sub cmdJk_Click()
If cmdJk.Caption = "查看已归还" Then
    cmdJk.Caption = "查看未归还"
    getJkList 1
Else
    cmdJk.Caption = "查看已归还"
    getJkList 0
End If


End Sub

Private Sub Command1_Click()

QueryQF cboND.Text, cboYf.ItemData(cboYf.ListIndex)

End Sub





Private Sub Command2_Click()
Shell "calc.exe", vbNormalFocus
End Sub

Private Sub DataGrid1_Click()

    'DataGrid1.DataSource = Adodc2
End Sub

Private Sub Form_Load()





LoadYear

'cboYf.ListIndex = GetMonthNo(VBA.Date)
GetJKInfo '借款统计

getJkList 0
  '买会统计
End Sub

Private Sub Form_Initialize()
    InitCommonControls
End Sub

'借款查询

Private Sub GetJKInfo()

Dim Var As Variant

Dim SQL As String
Dim Tmp As String

Var = GetValue("SELECT count(*) FROM 借款表")
If Var > 0 Then
    SQL = "SELECT COUNT(*) FROM 借款表"
    Var = GetValue(SQL)
    If IsNull(Var) = True Then
        Tmp = 0
    Else
        Tmp = CStr(Var)
    End If
    
    txtZjbs = Tmp
    
    SQL = "SELECT SUM(借款金额) FROM 借款表"
    Var = GetValue(SQL)
    If IsNull(Var) = True Then
        Tmp = 0
    Else
        Tmp = CStr(Var)
    End If
    
    txtZjje = Tmp
    
    SQL = "SELECT COUNT(*) FROM 借款表 WHERE 已还=true"
    Var = GetValue(SQL)
    If IsNull(Var) = True Then
        Tmp = 0
    Else
        Tmp = CStr(Var)
    End If
    
    txtYGH = Val(txtZjbs) - Val(Tmp)
    
    SQL = "SELECT SUM(借款金额) FROM 借款表 WHERE 已还=true"
    Var = GetValue(SQL)
    If IsNull(Var) = True Then
        Tmp = 0
    Else
        Tmp = CStr(Var)
    End If
    
    txtWghje = Val(txtZjje) - Val(Tmp)
    
    SQL = "SELECT MAX(借款金额) FROM 借款表 WHERE 已还=false"
    Var = GetValue(SQL)
    If IsNull(Var) = True Then
        Tmp = 0
    Else
        Tmp = CStr(Var)
    End If
    
    txtZgjk = Tmp
    
    Var = GetValue("SELECT count(*) FROM 借款明细表")
        If Var > 0 Then
        SQL = "SELECT 客户名称 FROM 借款明细表" ' WHERE 已还=false And 借款金额=" & txtZgjk
        Var = GetValue(SQL)
        If IsNull(Var) = True Then
            Tmp = 0
        Else
            Tmp = CStr(Var)
        End If
        
        txtJkzgxm = Tmp
        
        SQL = "SELECT MIN(借款时间) FROM 借款明细表"
        Var = GetValue(SQL)
        If IsNull(Var) = True Then
            Tmp = 0
        Else
            Tmp = CStr(Var)
        End If
        
        txtJkzj = Tmp
        
        SQL = "SELECT 客户名称 FROM 借款明细表 WHERE  借款时间=#" & txtJkzj & "#"
        Var = GetValue(SQL)
        If IsNull(Var) = True Then
            Tmp = 0
        Else
            Tmp = CStr(Var)
        End If
        txtJkzjxm = Tmp
    End If
    'SQL = "SELECT COUNT(*) FROM 借款表"
    'Tmp = Clng(GetValue(SQL))
    'txtZjbs = Tmp
End If
End Sub

Private Sub getJkList(ByVal Cs As Integer)

Dim Rs  As Recordset
If Cs = 0 Then

    Set Rs = GetRecord("SELECT * FROM 借款明细表")
Else
    Set Rs = GetRecord("SELECT * FROM 还款明细表")
End If


Dim C As Integer, i As Integer, j As Integer

LvJk.View = lvwReport '设置详细资料方式

C = Rs.Fields.Count

LvJk.ListItems.Clear
LvJk.ColumnHeaders.Clear

'添加表头
For i = 1 To C - 1
    LvJk.ColumnHeaders.Add , , Rs.Fields(i).Name
Next i
i = 0
'添加字段
Do While Not Rs.EOF
    LvJk.ListItems.Add , "KEY" & Rs.Fields(0).Value & "#" & Rs.Fields("借款时间"), Rs.Fields(1).Value   '添加第一个字段,关键字
    i = i + 1
    '添加其余字段
    For j = 2 To C - 1
        If IsNull(Rs.Fields(j).Value) Then
            LvJk.ListItems(i).SubItems(j - 1) = ""
        Else
            LvJk.ListItems(i).SubItems(j - 1) = Rs.Fields(j).Value
        End If
    Next j
    Rs.MoveNext
Loop

End Sub

Private Sub GetQfInfo(ByVal Dt As Date)
Dim Yr As Long
Dim Mt As Long
Yr = Year(Dt)
Mt = GetMonthNo(Dt)
End Sub



'查询欠费情况
Private Sub QueryQF(ByVal intYear As Long, ByVal MonthNo As Long)
Dim SQL     As String
Dim BgDate2 As Date
Dim Tmp     As Long
Dim TMP2    As String
Dim TMP3    As Long
Dim ZJhk    As Variant
Dim Rs      As Recordset


'计算有效入会时间
Tmp = MonthNo



TMP2 = Tmp - Tmp \ 4
    
If ((Tmp + 1) Mod 4) = 0 Then
    TMP3 = 15
Else
    TMP3 = GetLassDay(intYear, TMP2)
End If

BgDate2 = CDate(cboND.Text & "-" & TMP2 & "-" & TMP3)

'这里采用了子查询 (EXISTS) 查询另一张表里的记录是否存在
'并用到了"联合"查询(UNION) 把两个查询结果合并到一个记录集上


'取得未交人员名单

SQL = "SELECT 客户编号,帐本,编号,客户名称 FROM 明细表2 WHERE NOT EXISTS(SELECT * FROM 明细表 WHERE 明细表.客户=明细表2.客户编号"
SQL = SQL & " AND 年份=" & intYear
SQL = SQL & " AND 月份=" & MonthNo
SQL = SQL & " AND 金额<>0"
SQL = SQL & " AND 审核=TRUE"
SQL = SQL & ")"
SQL = SQL & " AND NOT EXISTS(SELECT * FROM 汇款表 WHERE 明细表2.客户编号=汇款表.客户编号)"

SQL = SQL & " AND 入会时间>#" & GetBeginDate & "#"
SQL = SQL & " AND 入会时间<=#" & BgDate2 & "#"

Set Rs = GetRecord(SQL)
RSToListView2 Rs, LvQh(0)

SQL = "SELECT 客户编号,帐本,编号,客户名称 FROM 明细表2 WHERE NOT EXISTS(SELECT * FROM 明细表 WHERE 明细表.客户=明细表2.客户编号"
SQL = SQL & " AND 年份=" & intYear
SQL = SQL & " AND 月份=" & MonthNo
SQL = SQL & " AND 金额<>0"
SQL = SQL & " AND 审核=TRUE"
SQL = SQL & ")"
SQL = SQL & " AND EXISTS(SELECT * FROM 汇款表 WHERE 明细表2.客户编号=汇款表.客户编号)"

SQL = SQL & " AND 入会时间>#" & GetBeginDate & "#"
SQL = SQL & " AND 入会时间<=#" & BgDate2 & "#"

Set Rs = GetRecord(SQL)
RSToListView2 Rs, LvHKZ(0)




SQL = "SELECT 客户编号,帐本,编号,客户名称 FROM 明细表2 WHERE EXISTS(SELECT * FROM 明细表 WHERE 明细表.客户=明细表2.客户编号"
SQL = SQL & " AND 年份=" & intYear
SQL = SQL & " AND 月份=" & MonthNo
SQL = SQL & " AND 金额<>0"
SQL = SQL & " AND 审核=TRUE"
SQL = SQL & ")"
SQL = SQL & " AND NOT EXISTS(SELECT * FROM 汇款表 WHERE 明细表2.客户编号=汇款表.客户编号)"
SQL = SQL & " AND 入会时间>#" & GetBeginDate & "#"
SQL = SQL & " AND 入会时间<=#" & BgDate2 & "#"

Set Rs = GetRecord(SQL)
RSToListView2 Rs, LvQh(1)


SQL = "SELECT 客户编号,帐本,编号,客户名称 FROM 明细表2 WHERE EXISTS(SELECT * FROM 明细表 WHERE 明细表.客户=明细表2.客户编号"
SQL = SQL & " AND 年份=" & intYear
SQL = SQL & " AND 月份=" & MonthNo
SQL = SQL & " AND 金额<>0"
SQL = SQL & " AND 审核=TRUE"
SQL = SQL & ")"
SQL = SQL & " AND EXISTS(SELECT * FROM 汇款表 WHERE 明细表2.客户编号=汇款表.客户编号)"
SQL = SQL & " AND 入会时间>#" & GetBeginDate & "#"
SQL = SQL & " AND 入会时间<=#" & BgDate2 & "#"

Set Rs = GetRecord(SQL)
RSToListView2 Rs, LvHKZ(1)


 SQL = "SELECT SUM(金额) FROM 明细表 WHERE 年份=" & cboND.Text
 SQL = SQL & " AND 月份=" & cboYf.ItemData(cboYf.ListIndex)
 SQL = SQL & " AND 审核=TRUE"
 ZJhk = GetValue(SQL)
 
 

 If Not IsNull(ZJhk) Then
    txtZJhk.Text = CStr(ZJhk)
 Else
    txtZJhk = 0
 End If
 
 txtWSBS.Text = LvQh(0).ListItems.Count + LvHKZ(0).ListItems.Count
 txtSDBS.Text = LvQh(1).ListItems.Count + LvHKZ(1).ListItems.Count
 '总计未收金额
 txtWSK = GetTotalQF

End Sub


 '返回某年某月的最后一天

Private Function GetLassDay(ByVal Yr As Long, ByVal Mt As Long) As Long
    Dim PR   As Long '保存平年闰年
    Dim Rtrn As Long '返回值

    If Yr Mod 4 = 0 Then
        PR = 1
    Else
       PR = 0
    End If
    
    Select Case Mt
     Case 1
        Rtrn = 31
     Case 2
        Rtrn = 28 + PR
     Case 3 To 7
        Rtrn = 30 + Mt Mod 2
     Case 8 To 12
        Rtrn = 31 - Mt Mod 2
     End Select
     GetLassDay = Rtrn
End Function


Private Sub Form_Resize()

On Error Resume Next

SSTab2.Width = Me.ScaleWidth
SSTab2.Height = Me.ScaleHeight


End Sub

Private Sub Label30_Click()

End Sub



Private Sub LvHKZ_ColumnClick(Index As Integer, ByVal ColumnHeader As MSComctlLib.ColumnHeader)

If LvHKZ(Index).SortOrder = lvwAscending Then
    LvHKZ(Index).SortOrder = lvwDescending
Else
    LvHKZ(Index).SortOrder = lvwAscending
End If

LvHKZ(Index).Sorted = True
LvHKZ(Index).SortKey = ColumnHeader.SubItemIndex

End Sub

Private Sub LvHKZ_DblClick(Index As Integer)
 If LvHKZ(Index).ListItems.Count > 0 Then
    If LvHKZ(Index).SelectedItem.Index > 0 Then
    
        Dim Id As Long
        Id = CLng(Mid(LvHKZ(Index).SelectedItem.Key, 4))
        frmDj.Cust = Id
        frmDj.Show
    End If
 End If
End Sub

Private Sub LvJk_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If LvJk.SortOrder = lvwAscending Then
    LvJk.SortOrder = lvwDescending
Else
    LvJk.SortOrder = lvwAscending
End If

LvJk.Sorted = True
LvJk.SortKey = ColumnHeader.SubItemIndex
End Sub

Private Sub LvJk_DblClick()

 If LvJk.ListItems.Count > 0 Then
    If LvJk.SelectedItem.Index > 0 Then
    
        Dim Id As Long
        Id = Val(Mid(LvJk.SelectedItem.Key, 4))
        FrmDj2.Client = Id
        FrmDj2.Show
    End If
 End If
 


End Sub

Private Sub LvQh_ColumnClick(Index As Integer, ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If LvQh(Index).SortOrder = lvwAscending Then
    LvQh(Index).SortOrder = lvwDescending
Else
    LvQh(Index).SortOrder = lvwAscending
End If

LvQh(Index).Sorted = True
LvQh(Index).SortKey = ColumnHeader.SubItemIndex
End Sub

Private Sub LvQh_DblClick(Index As Integer)
If LvQh(Index).ListItems.Count > 0 Then
    If LvQh(Index).SelectedItem.Index > 0 Then
        Dim Id As Long
        Id = CLng(Mid(LvQh(Index).SelectedItem.Key, 4))
        frmDj.Cust = Id
        frmDj.Show
    End If
End If
End Sub





Private Function GetTotalQF() As Long


Dim i     As Long
Dim Tatol As Long
Dim tmpClient As Long



For i = 1 To LvQh(0).ListItems.Count
    tmpClient = CLng(Mid(LvQh(0).ListItems(i).Key, 4))
    Tatol = Tatol + GetMoney(tmpClient, CInt(cboND.Text), CInt(cboYf.ItemData(cboYf.ListIndex)))
Next

For i = 1 To LvHKZ(0).ListItems.Count
    tmpClient = CLng(Mid(LvHKZ(0).ListItems(i).Key, 4))
    Tatol = Tatol + GetMoney(tmpClient, CInt(cboND.Text), CInt(cboYf.ItemData(cboYf.ListIndex)))
Next


GetTotalQF = Tatol


End Function


Private Sub LoadYear() '载入年列表


Dim i As Long
Dim j As Integer
Dim K As Integer

K = GetMonthNo(Date)

If K = 15 Then
    j = 4
Else
    j = 5
End If


For i = Year(VBA.Date) - j To Year(VBA.Date)
    cboND.AddItem i
Next


cboND.ListIndex = cboND.ListCount - 1


End Sub