table.ctl

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

 m_Year = vNewValue
ReFlash

End Property

Private Sub Check1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

 RaiseEvent Change(Index + 1)
 m_Changed = True
 rowChange(Index) = True
End Sub

Private Sub Check1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 RaiseEvent Change(Index + 1)
 m_Changed = True
 rowChange(Index) = True
 
End Sub

Private Sub Label3_Click(Index As Integer)
Static flag(2) As Boolean

flag(Index) = Not flag(Index)

Select Case Index

Case 0

 If flag(Index) Then
    
 End If

Case 1

Case 2
    
End Select
End Sub



Public Function Save() As Boolean

If m_Changed Then
    Dim I  As Integer
    Dim SQL As String
    Dim Tj As String
    
    For I = 0 To 15
        If rowChange(I) = True Then
            Tj = " Where 年份=" & curYear & " And 客户=" & Client & " And 月份=" & Label1(I).Tag
            SQL = "SELECT Count(*) From 明细表" & Tj '判断表里是否已经有这一条
            If Val(GetValue(SQL)) = 0 Then
                SQL = "Insert into 明细表 Values("
                SQL = SQL & curYear & ","
                SQL = SQL & Label1(I).Tag & ","
                SQL = SQL & m_Client & ","
                SQL = SQL & Val(Text1(I).Text) & ","
                SQL = SQL & Check1(I).Value & ")"
            Else
                SQL = "Update 明细表"
                SQL = SQL & " SET 金额=" & Val(Text1(I).Text)
                SQL = SQL & ",审核=" & Check1(I).Value
                SQL = SQL & Tj
            End If
                ExecSQL SQL
                
            If m_Mapped = True Then '进行映射
                Mapping Label1(I).Tag, Check1(I).Value
            End If
        End If
    Next
 
End If

mdCom.Release
End Function















Private Sub Label2_Click(Index As Integer)

End Sub

Private Sub Text1_Click(Index As Integer)
If m_Auto = True Then
    If Val(Text1(Index)) = 0 Then
        Text1(Index).Text = CStr(Money(Index + 1))
        rowChange(Index) = True
        Check1(Index).Value = 1
        RaiseEvent Change(Index + 1)
        m_Changed = True
    End If
End If
End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    RaiseEvent Change(Index + 1)
    rowChange(Index) = True
    m_Changed = True
End Sub

Private Sub Text1_Validate(Index As Integer, Cancel As Boolean)
If Trim(Text1(Index).Text) <> "" Then
    If Not IsNumeric(Text1(Index).Text) Then
        MsgBox Me.curYear & "年度" & Label1(Index).Caption & "输入的加会款格式无效！", vbOKOnly + 48, "错误"
        Cancel = True
    End If
Else
    Text1(Index).Text = "0"
End If
End Sub

Private Sub UserControl_Initialize()
'conStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DataFile & ";Persist Security Info=False"

mdCom.Driver = DV_Access

End Sub


Public Property Get DataFile() As String
DataFile = m_DataFile
End Property

Public Property Let DataFile(ByVal vNewValue As String)
m_DataFile = vNewValue
mdCom.DataSource = vNewValue

If vNewValue <> "" Then
    GetMonth
End If
End Property


Private Sub GetMonth()

    Dim Rs As Recordset
    Dim I As Integer
    Set Rs = GetRecord("SELECT * From 月份表")
    Do While Not Rs.EOF
        Text1(I).Enabled = True
        Check1(I).Enabled = True
        Label1(I).Caption = Rs.Fields(1)
        Label1(I).Tag = Rs.Fields(0)
        I = I + 1
        Rs.MoveNext
    Loop
mdCom.Release
End Sub

Public Property Get Client() As Long
Client = m_Client
End Property

Public Property Let Client(ByVal vNewValue As Long)
    m_Client = vNewValue
End Property

Public Sub ReFlash()
Dim Dt  As Date
Dim I   As Integer
Dim SQL As String
Dim Rs  As Recordset
Dim Yr  As Integer
Dim Mt  As Integer
Yr = m_Year

    
Dt = CDate(GetValue("SELECT 入会时间 From 客户表 Where 客户编号=" & m_Client))
Mt = GetMonthNo(Dt)


For I = 0 To 15
    Text1(I).Text = 0
    Check1(I).Value = 0
    rowChange(I) = False
    'If Yr < Year(Now) - 5 Then
    '    Text1(I).Enabled = False
    '    Check1(I).Enabled = False
    'End If
    
    If Yr <= Year(Dt) Then
        If I < Mt Then
            Text1(I).Text = "0"
            Check1(I).Value = 0
            Text1(I).Enabled = False
            Check1(I).Enabled = False
        Else
                Text1(I).Enabled = True
                Check1(I).Enabled = True
        End If
    Else
        If Yr = (Year(Dt) + 5) Then
           If I >= Mt Then
                Text1(I).Text = "0"
                Check1(I).Value = 0
                Text1(I).Enabled = False
                Check1(I).Enabled = False
            Else
                Text1(I).Enabled = True
                Check1(I).Enabled = True
           End If
        End If
    End If
Next



'If Yr >= Year(Dt) Then
        SQL = "SELECT 月份,金额,审核 From 明细表 where 年份=" & m_Year & " And 客户=" & m_Client
        Set Rs = GetRecord(SQL)
        Do While Not Rs.EOF
            Mt = Rs.Fields("月份")
            Text1(Mt - 1).Text = Rs.Fields("金额")
            Check1(Mt - 1).Value = Abs(Rs.Fields("审核"))
            Rs.MoveNext
        Loop
'End If

mdCom.Release
End Sub

Public Property Get Changed() As Boolean
    Changed = m_Changed
    'RaiseEvent Change
End Property


Public Property Get Enabled() As Boolean

Enabled = UserControl.Enabled

End Property

Public Property Let Enabled(ByVal vNewValue As Boolean)

UserControl.Enabled = vNewValue


End Property


Public Property Get Money(Optional ByVal Mnth As Integer) As Long '算出会员实际该交的金额

Dim Tmp As Variant
Dim SQL As String



SQL = "SELECT TOP 1 应缴金额 From 买会表"
SQL = SQL & " WHERE 客户编号=" & m_Client
SQL = SQL & " And 日期<=#" & GetDate(Me.curYear, Mnth) & "#"
SQL = SQL & " ORDER BY 日期 DESC"


Tmp = GetValue(SQL)

If Not IsNull(Tmp) Then
   Money = CLng(Tmp)
Else
   Money = 0
End If

End Property


Public Property Get Locked() As Boolean

Locked = m_Lock

End Property

Public Property Let Locked(ByVal vNewValue As Boolean)
m_Lock = vNewValue
Dim I As Integer
    For I = 0 To 15
        Text1(I).Enabled = Not vNewValue
        Check1(I).Enabled = Not vNewValue
    Next
End Property

Public Property Get Auto() As Boolean
    Auto = m_Auto
End Property

Public Property Let Auto(ByVal vNewValue As Boolean)
m_Auto = vNewValue
End Property

Public Property Get Mapped() As Boolean

    Mapped = m_Mapped

End Property

Public Property Let Mapped(ByVal vNewValue As Boolean)

    m_Mapped = vNewValue

End Property


Private Sub Mapping(ByVal iMonth As Integer, ByVal FJ As Boolean) '组映射

    Dim Tmp      As Variant
    Dim Rs       As Recordset
    Dim SQL      As String
    Dim TmID     As Long '同名ID
    Dim KHID     As Long '客户编号
    Dim lMoney   As Long '应缴金额
    Dim Bgdate   As String
    Dim rhSj     As String '入会时间
    

    SQL = "SELECT 同名编号 FROM 成员表 WHERE 客户编号=" & Me.Client
    Tmp = GetValue(SQL)
    
    If Not IsNull(Tmp) Then
        TmID = CLng(Tmp)
    Else
        Exit Sub
    End If
    
    
    SQL = "SELECT 客户编号 FROM 成员表 WHERE 同名编号=" & TmID
    Set Rs = GetRecord(SQL)
    
    Do While Not Rs.EOF
    
        If Rs.Fields("客户编号") <> Me.Client Then  '取得客户编号
        
            KHID = Rs.Fields("客户编号")
            
        '###############################################################判断是否在有效时间段
            SQL = "SELECT 入会时间 FROM 客户表 WHERE 客户编号=" & KHID
            rhSj = CStr(GetValue(SQL))
            
            Dim MM As Integer
            Dim DD As String
            
            MM = iMonth - iMonth \ 4
            If iMonth Mod 4 = 0 Then
                DD = 16
            Else
                DD = 1
            End If
            
            Bgdate = Me.curYear & "-" & MM & "-" & DD
            
                    MM = Month(CDate(rhSj))
                    DD = Day(CDate(rhSj))
                    rhSj = Year(CDate(rhSj))
                    rhSj = rhSj & "-" & MM
                    If CInt(MM) Mod 3 = 0 Then
                        DD = IIf(DD >= 16, 16, 1)
                    Else
                        DD = 1
                    End If
                    rhSj = rhSj & "-" & DD
            
            If CDate(Bgdate) >= CDate(rhSj) Then
                    MM = Month(CDate(rhSj))
                    DD = Day(CDate(rhSj))
                    rhSj = (Year(CDate(rhSj)) + 5)
                    rhSj = rhSj & "-" & MM
                    
                    If CInt(MM) Mod 3 = 0 Then
                        DD = IIf(DD >= 16, 16, 1)
                    Else
                        DD = 1
                    End If
                    
                        rhSj = rhSj & "-" & DD
                    
                    If CDate(Bgdate) < CDate(rhSj) Then
        '###############################################################
                     '=========================取得这个成员应该交的金额
                     If FJ = True Then
                        SQL = "SELECT TOP 1 应缴金额 From 买会表"
                        SQL = SQL & " WHERE 客户编号=" & KHID
                        SQL = SQL & " And 日期<=#" & GetDate(Me.curYear, iMonth) & "#"
                        SQL = SQL & " ORDER BY 日期 DESC"
                        Tmp = GetValue(SQL)
                    Else
                        Tmp = 0
                    End If
            
                        If Not IsNull(Tmp) Then
                            
                            lMoney = CLng(Tmp)
                            
                            If lMoney = 0 Then
                                If FJ = True Then
                                    GoTo MoneyER
                                End If
                            End If
                            
                            SQL = "SELECT Count(*) From 明细表"  '判断表里是否已经有这一条
                            SQL = SQL & " Where 年份=" & curYear & " And 客户=" & KHID & " And 月份=" & iMonth
                            
                            If Val(GetValue(SQL)) = 0 Then
                                SQL = "Insert into 明细表 Values("
                                SQL = SQL & curYear & ","
                                SQL = SQL & iMonth & ","
                                SQL = SQL & KHID & ","
                                SQL = SQL & lMoney & ","
                                SQL = SQL & CStr(FJ) & ")"
                            Else
                                SQL = "Update 明细表"
                                SQL = SQL & " SET 金额=" & lMoney
                                SQL = SQL & ",审核=" & CStr(FJ)
                                SQL = SQL & " Where 年份=" & curYear & " And 客户=" & KHID & " And 月份=" & iMonth
                            End If
                            ExecSQL SQL
                        Else
MoneyER:
                            Dim KHMC  As String
                            KHMC = GetValue("SELECT 客户名称 FROM 客户表 WHERE 客户编号=" & KHID)
                            MsgBox KHMC & "的加会款金额没有设置，或已设置但无效!", vbOKOnly + 48
                        End If
                    End If
                End If
             End If
         Rs.MoveNext
        Loop
'======================================================
End Sub