📄 form3.frm
字号:
End
Begin VB.CommandButton Command1
Caption = "注解"
Height = 375
Left = 9300
TabIndex = 10
Top = 0
Width = 1095
End
End
End
End
Attribute VB_Name = "frmDj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_Cust As Long
Public beginYear As Integer
Private SZZB As Integer
Private Sub cboKH_Click()
cmdQh.Enabled = True
End Sub
Private Sub cmdPGDW_Click()
cmdPgUP.Enabled = True
If List1.ListIndex < List1.ListCount - 1 Then
List1.ListIndex = List1.ListIndex + 1
If List1.ListIndex = List1.ListCount - 1 Then cmdPGDW.Enabled = False
Me.Cust = List1.ItemData(List1.ListIndex)
Reload
End If
End Sub
Private Sub cmdPgUP_Click()
cmdPGDW.Enabled = True
If List1.ListIndex > 0 Then
List1.ListIndex = List1.ListIndex - 1
If List1.ListIndex = 0 Then cmdPgUP.Enabled = False
Me.Cust = List1.ItemData(List1.ListIndex)
Reload
End If
End Sub
'Private Sub cmdQh_Click()
'txtCust.Text = cboKH.Text
'Cust = cboKH.ItemData(cboKH.ListIndex)
'reload
'End Sub
Private Sub cmdSave_Click()
Dim SQL As String
cmdSave.Enabled = False
Table1(0).Save
Table1(1).Save
Table1(2).Save
Table1(3).Save
Table1(4).Save
Table1(5).Save
End Sub
Private Sub Command1_Click()
FrmDj2.Client = Cust
FrmDj2.Show
End Sub
Private Sub Command2_Click()
Dim I As Integer
For I = 0 To 5
If Table1(I).Changed = True Then
Table1(I).ReFlash
End If
Next
cmdSave.Enabled = False
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command5_Click()
UPDateInfo
MsgBox "OK!"
End Sub
Private Sub Form_Initialize()
InitCommonControls
End Sub
Private Sub Form_Load()
Dim SQL As String
Dim I As Integer
For I = 0 To 5
Table1(I).DataFile = DataFile
Next
'Reload
End Sub
Private Sub Reload()
Dim Dt As Date
Dim Rs As New ADODB.Recordset
Set Rs = GetRecord("SELECT 活名,实名,买会,买会金额,会款 From 买会表 Where 客户编号=" & Cust)
If (Not Rs.EOF) Or (Not Rs.BOF) Then
txtSm.Text = Rs!实名
txtMh = Rs!买会
txtMHje = Rs!买会金额
txtHm = Rs!活名
txtHk = Rs!会款
Else
txtSm.Text = 0
txtMh = 0
txtMHje = 0
txtHm = 0
txtHk = 0
End If
txtCust = GetValue("SELECT 客户名称 FROM 客户表 Where 客户编号=" & Cust)
lblBh.Caption = GetValue("SELECT 编号 FROM 客户表 Where 客户编号=" & Cust)
Dt = CDate(GetValue("SELECT 入会时间 From 客户表 Where 客户编号=" & Cust))
If GetMonthNo(Dt) = 0 Then
Picture1.Width = (Table1(0).Width + 60) * 5 - 60
Table1(5).Visible = False
Else
Picture1.Width = (Table1(0).Width + 60) * 6 - 60
Table1(5).Visible = True
End If
beginYear = Year(Dt)
Dim I As Integer
For I = 0 To 5
Table1(I).Client = Cust
Table1(I).curYear = beginYear + I
Next
'==================获取同一本的客户列表
SZZB = GetValue("SELECT 所在帐本 FROM 客户表 Where 客户编号=" & Cust)
SQL = "SELECT 客户编号,客户名称 From 客户表 Where 所在帐本=" & SZZB & " Order by 编号"
AddToList SQL, List1
'定位
For I = 0 To List1.ListCount - 1
If List1.ItemData(I) = Cust Then
List1.ListIndex = I
Exit For
End If
Next
cmdPgUP.Enabled = IIf(List1.ListIndex > 0, True, False)
cmdPGDW.Enabled = IIf(List1.ListIndex < List1.ListCount - 1, True, False)
'==========================备注信息
Bz = GetValue("SELECT 备注 FROM 客户表 Where 客户编号=" & Cust)
If Not IsNull(Bz) Then txtBz = Bz
End Sub
Private Sub Form_Resize()
On Error Resume Next
'Dim T As Long
'Dim C As Long
'Dim B As Long
'Dim A As Long
'A = Frame2.Height + Frame3.Height + Picture1.Height
T = Me.ScaleHeight - Frame2.Height - Frame3.Height - Picture1.Height
Frame3.Top = T / 2
Picture1.Top = Frame3.Top + Frame3.Height
HSC.Top = Picture1.Top + Picture1.Height
Frame2.Top = HSC.Top + HSC.Height
Dim HscMax As Long
'Frame3.Width = Me.ScaleWidth
HscMax = (Picture1.Width - Me.ScaleWidth)
If HscMax > 0 Then
HSC.Max = HscMax
HSC.Width = Me.ScaleWidth
HSC.SmallChange = HSC.Max / 100
HSC.LargeChange = HSC.Max / 10
Picture1.Left = 0
HSC.Visible = True
Else
Picture1.Left = Abs(HscMax / 2)
HSC.Visible = False
End If
Frame3.Width = Picture1.ScaleWidth
Frame2.Width = Picture1.ScaleWidth
Frame3.Left = Picture1.Left
Frame2.Left = Picture1.Left
End Sub
Private Sub Form_Unload(Cancel As Integer)
If cmdSave.Enabled = True Then
If MsgBox("是否保存对当前页的更改?", vbYesNo + vbQuestion + vbDefaultButton1, "未保存的数据") = vbYes Then
cmdSave_Click
End If
End If
End Sub
Private Sub HSC_Change()
Picture1.Left = -HSC.Value
End Sub
Private Sub Picture1_Resize()
On Error Resume Next
HscMax = (Picture1.ScaleWidth - Me.Width)
If HscMax > 0 Then
HSC.Max = HscMax
HSC.Width = Me.Width
HSC.SmallChange = HSC.Max / 100
HSC.LargeChange = HSC.Max / 10
Picture1.Left = 0
HSC.Visible = True
Else
Picture1.Left = Abs(HscMax / 2)
HSC.Visible = False
End If
Frame3.Width = Picture1.ScaleWidth
Frame2.Width = Picture1.ScaleWidth
Frame3.Left = Picture1.Left
Frame2.Left = Picture1.Left
End Sub
Private Sub Table1_Change(index As Integer)
cmdSave.Enabled = True
End Sub
Private Sub UPDateInfo()
Dim SQL As String
Dim T As Integer
SQL = ("SELECT count(*) FROM 买会表 Where 客户编号=" & Cust)
T = CInt(GetValue(SQL))
If T >= 1 Then
SQL = "Update 买会表 Set "
SQL = SQL & "活名=" & Val(txtHm)
SQL = SQL & ",会款=" & Val(txtHk)
SQL = SQL & ",实名=" & Val(txtSm)
SQL = SQL & ",买会=" & Val(txtMh)
SQL = SQL & ",买会金额=" & Val(txtMHje)
SQL = SQL & " Where 客户编号=" & Cust
Else
SQL = "Insert Into 买会表(客户编号,活名,会款,实名,买会,买会金额) Values("
SQL = SQL & Cust
SQL = SQL & "," & Val(txtHm)
SQL = SQL & "," & Val(txtHk)
SQL = SQL & "," & Val(txtSm)
SQL = SQL & "," & Val(txtMh)
SQL = SQL & "," & Val(txtMHje)
SQL = SQL & ")"
End If
ExecSQL SQL
End Sub
Public Property Get Cust() As Long
Cust = m_Cust
End Property
Public Property Let Cust(ByVal vNewValue As Long)
m_Cust = vNewValue
Reload
Me.SetFocus
End Property
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -