📄 frmkhbm.frm
字号:
Height = 375
Left = 120
TabIndex = 62
Top = 4800
Width = 615
End
Begin VB.Label Label1
Caption = "注意：带**号的字段不能为空"
Height = 255
Left = 600
TabIndex = 59
Top = 0
Width = 2535
End
Begin VB.Label lblLabels
Caption = "单位编码: **"
Height = 255
Index = 1
Left = 4320
TabIndex = 58
Top = 480
Width = 1305
End
Begin VB.Label lblLabels
Caption = "简称:"
Height = 255
Index = 3
Left = 120
TabIndex = 57
Top = 1200
Width = 1305
End
Begin VB.Label lblLabels
Caption = "开户行:"
Height = 255
Index = 4
Left = 120
TabIndex = 56
Top = 2670
Width = 1305
End
Begin VB.Label lblLabels
Caption = "税号:"
Height = 255
Index = 6
Left = 4320
TabIndex = 55
Top = 2640
Width = 1305
End
Begin VB.Label lblLabels
Caption = "地址:"
Height = 255
Index = 7
Left = 120
TabIndex = 54
Top = 3390
Width = 1305
End
Begin VB.Label lblLabels
Caption = "电话:"
Height = 255
Index = 8
Left = 4320
TabIndex = 53
Top = 3000
Width = 1305
End
Begin VB.Label lblLabels
Caption = "传真:"
Height = 255
Index = 9
Left = 4320
TabIndex = 52
Top = 3360
Width = 1305
End
Begin VB.Label lblLabels
Caption = "邮编:"
Height = 255
Index = 10
Left = 120
TabIndex = 51
Top = 3750
Width = 1305
End
Begin VB.Label lblLabels
Caption = "省份: **"
Height = 255
Index = 12
Left = 4320
TabIndex = 50
Top = 1590
Width = 1305
End
Begin VB.Label lblLabels
Caption = "帐面余额:"
Height = 255
Index = 15
Left = 4320
TabIndex = 49
Top = 2280
Width = 1305
End
Begin VB.Label lblLabels
Caption = "联系人:"
Height = 255
Index = 16
Left = 120
TabIndex = 48
Top = 4110
Width = 1305
End
Begin VB.Label lblLabels
Caption = "联系人电话:"
Height = 255
Index = 17
Left = 4320
TabIndex = 47
Top = 3720
Width = 1305
End
Begin VB.Label lblLabels
Caption = "综合地区: **"
Height = 255
Index = 18
Left = 4320
TabIndex = 46
Top = 1950
Width = 1305
End
Begin VB.Label lblLabels
Caption = "电子信箱:"
Height = 285
Index = 19
Left = 4320
TabIndex = 45
Top = 4080
Width = 1305
End
Begin VB.Label lblLabels
Caption = "主页:"
Height = 255
Index = 20
Left = 120
TabIndex = 44
Top = 4470
Width = 1305
End
Begin VB.Label lblLabels
Caption = "发货性质:"
Height = 255
Index = 14
Left = 120
TabIndex = 43
Top = 2310
Width = 1305
End
Begin VB.Label lblLabels
Caption = "业务地区: **"
Height = 255
Index = 13
Left = 120
TabIndex = 42
Top = 1590
Width = 1305
End
Begin VB.Label lblLabels
Caption = "部门: **"
Height = 255
Index = 11
Left = 120
TabIndex = 41
Top = 1950
Width = 1305
End
Begin VB.Label lblLabels
Caption = "单位名称: **"
Height = 255
Index = 2
Left = 120
TabIndex = 40
Top = 840
Width = 1305
End
Begin VB.Label lblLabels
Caption = "客户序号: **"
Height = 255
Index = 0
Left = 120
TabIndex = 39
Top = 480
Width = 1305
End
Begin VB.Label lblLabels
Caption = "账号:"
Height = 255
Index = 5
Left = 120
TabIndex = 38
Top = 3030
Width = 1305
End
End
End
Attribute VB_Name = "frmKHBM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'提供对客户编码表的维护功能
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mvbookmark1 As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean
Dim rsSfbm As New ADODB.Recordset
Dim rsBmbm As New ADODB.Recordset
Dim rsDq As New Recordset
Dim rsdqbm As New Recordset
Dim rsSFBM1 As New ADODB.Recordset
Dim rsBmbm1 As New ADODB.Recordset
Dim rsDq1 As New Recordset
Dim rsDqbm1 As New Recordset
Dim ListSFIndex As Integer 'listbox中的当前选中项
Dim listBMindex As Integer
Dim NullWarnFlag As Boolean
Dim khNum As Integer '客户序号的最大值
Dim rsKhbm As Recordset
Dim opAdded As Boolean
Dim opEdited As Boolean
Dim Zbyj As Double
Dim Zzyj As Double
Dim Yxzyj As Double
Dim Exzyj As Double
Dim Xcyj As Double
'查询
Private Sub cmdQuery_Click()
Me.Hide
frmkhbmcx.Show
End Sub
'保证双击打开编码维护界面后的当前记录为双击CELL时对应的记录
Private Sub Form_Activate()
If Me.Tag <> "" Then
adoPrimaryRS.Requery
adoPrimaryRS.MoveFirst
adoPrimaryRS.Find ("单位编码='" & Me.Tag & "'")
End If
GetData ''''''''向文本框中写待显示记录的数据
End Sub
Private Sub Form_Load()
opAdded = False
opEdited = False
dblgjx.Execute "update khbm set 帐面余额=0 where 帐面余额 is null"
Set adoPrimaryRS = New Recordset
adoPrimaryRS.Open "select 客户序号,单位编码,单位名称,简称,开户行,账号," & _
"税号,地址,电话,传真,邮编,部门名称,省份名称,d.地区名称,发货性质,帐面余额,联系人," & _
"联系人电话,e.地区名称,电子信箱,主页,法人,流水号,最新标志 ,所属科室,中板预交,中轧预交,一小轧预交,二小轧预交,线材预交,电挂 " & _
" from KHBM a,bmbm b,sfbm c,dqbm d,dq e where 最新标志='1' and a.部门=b.部门编码 and a.省份=c.省份编码 and " & _
"a.业务地区=d.地区编码 and a.综合地区=e.地区编码 Order by 客户序号", dblgjx, adOpenStatic, adLockOptimistic
adoPrimaryRS.MoveFirst
GetData
Set rsKhbm = New Recordset
rsKhbm.Open "select 单位编码,单位名称,最新标志 from khbm order by substr(单位编码,1,4) ,substr(单位编码,6,4)", dblgjx, adOpenStatic, adLockOptimistic
mbDataChanged = False
rsSfbm.Open "select * from sfbm order by 省份编码", dblgjx, adOpenStatic, adLockOptimistic
rsBmbm.Open "select * from bmbm order by 部门编码", dblgjx, adOpenStatic, adLockOptimistic
rsDq.Open "select * from dq order by 地区编码", dblgjx, adOpenStatic, adLockOptimistic
rsdqbm.Open "select * from dqbm order by 地区编码", dblgjx, adOpenStatic, adLockOptimistic
rsSFBM1.Open "select * from sfbm order by 省份编码", dblgjx, adOpenStatic, adLockOptimistic
rsBmbm1.Open "select * from bmbm order by 部门编码", dblgjx, adOpenStatic, adLockOptimistic
rsDq1.Open "select * from dq order by 地区编码", dblgjx, adOpenStatic, adLockOptimistic
rsDqbm1.Open "select * from dqbm order by 地区编码", dblgjx, adOpenStatic, adLockOptimistic
'因为在开始状态时listbox中无选中项，所以要初始化
ListSFIndex = 0
listBMindex = 0
End Sub
Private Sub Form_Resize()
On Error Resume Next
lblStatus.Width = Me.Width - 1500
cmdNext.Left = lblStatus.Width + 700
cmdLast.Left = cmdNext.Left + 340
End Sub
Private Sub Form_Unload(Cancel As Integer)
Screen.MousePointer = vbDefault
If rsBmbm.State = adStateOpen Then rsBmbm.Close
If rsSfbm.State = adStateOpen Then rsSfbm.Close
If rsdqbm.State = adStateOpen Then rsdqbm.Close
If rsDq.State = adStateOpen Then rsDq.Close
If rsSFBM1.State = adStateOpen Then rsSFBM1.Close
If rsBmbm1.State = adStateOpen Then rsBmbm1.Close
If rsDqbm1.State = adStateOpen Then rsDqbm1.Close
If rsDq1.State = adStateOpen Then rsDq1.Close
End Sub
Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'为这个 recordset 显示当前记录位置
lblStatus.Caption = "Record: " & CStr(adoPrimaryRS.AbsolutePosition)
End Sub
Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'验证代码置于此处
'下列动作发生时该事件被调用
Dim bCancel As Boolean
Select Case adReason
Case adRsnAddNew
Case adRsnClose
Case adRsnDelete
Case adRsnFirstChange
Case adRsnMove
Case adRsnRequery
Case adRsnResynch
Case adRsnUndoAddNew
Case adRsnUndoDelete
Case adRsnUndoUpdate
Case adRsnUpdate
End Select
If bCancel Then adStatus = adStatusCancel
End Sub
'添加
Private Sub cmdAdd_Click()
On Error GoTo AddErr
Frame.Enabled = True
For i = 0 To 3
txtFields(i).Enabled = True
txtFields(i).Locked = False
Next
ResumeColor '''''''''''''恢复文本框的颜色
txtFields(15).Enabled = False '帐面余额赋为0
txtFields(15) = 0
Dim rstemp1 As Recordset
Set rstemp1 = New Recordset
rstemp1.Open "select max(客户序号) from khbm", dblgjx, adOpenStatic, adLockOptimistic
cmdClose.Enabled = False
cmdAdd.Enabled = False
cmdQuery.Enabled = False
cmdCancel.Enabled = True
cmdUpdate.Visible = True
cmdEdit.Visible = False
lblStatus.Caption = "添加记录(注意:当前最大的客户序号为" & rstemp1(0) & ")"
With adoPrimaryRS
If Not (.BOF And .EOF) Then
mvBookMark = .Bookmark
End If
End With
mbAddNewFlag = True
SetButtons False
opAdded = True
Exit Sub
AddErr:
MsgBox Err.Description
End Sub
'刷新
Private Sub cmdRefresh_Click()
'只有多用户应用程序需要
On Error GoTo RefreshErr
adoPrimaryRS.Requery
Exit Sub
RefreshErr:
MsgBox Err.Description
End Sub
'修改
Private Sub cmdEdit_Click()
On Error GoTo EditErr
Frame.Enabled = True
For i = 0 To 3
txtFields(i).Locked = True
txtFields(i).Enabled = False
Next
If txtFields(15).BackColor = &HE0E0E0 Then txtFields(15).BackColor = &H80000005
Changecolor '''''''''不允许修改的文本框变灰
Zbyj = adoPrimaryRS(25)
Zzyj = adoPrimaryRS(26)
Yxzyj = adoPrimaryRS(27)
Exzyj = adoPrimaryRS(28)
Xcyj = adoPrimaryRS(29)
'设标签
mvbookmark1 = adoPrimaryRS.Bookmark
cmdAdd.Enabled = False
cmdQuery.Enabled = False
cmdClose.Enabled = False
cmdCancel.Enabled = True
cmdUpdate.Visible = True
cmdEdit.Visible = False
lblStatus.Caption = "修改记录"
mbEditFlag = True
SetButtons False
opEdited = True
Exit Sub
EditErr:
MsgBox Err.Description
End Sub
'取消操作
Private Sub cmdCancel_Click()
On Error Resume Next
'先清空所写数据
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -