?? form3.frm
字號:
VERSION 5.00
Object = "{CFA7AFF4-3242-4269-9172-7389D695AE01}#1.0#0"; "StoneXP.ocx"
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx"
Begin VB.Form Form3
BorderStyle = 3 'Fixed Dialog
Caption = "客戶信息管理"
ClientHeight = 7455
ClientLeft = 45
ClientTop = 375
ClientWidth = 10860
LinkTopic = "Form3"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 7455
ScaleWidth = 10860
ShowInTaskbar = 0 'False
Begin StoneXP.XPButton XPButton6
Height = 375
Left = 4320
TabIndex = 6
Top = 6840
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "充 值"
MouseIcon = "Form3.frx":0000
MousePointer = 99
End
Begin FlexCell.Grid Grid1
Height = 6255
Left = 0
TabIndex = 0
Top = 240
Width = 10815
_ExtentX = 19076
_ExtentY = 11033
Cols = 5
Rows = 30
End
Begin StoneXP.XPButton XPButton5
Height = 375
Left = 8280
TabIndex = 1
Top = 6840
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "退 出"
MouseIcon = "Form3.frx":031A
MousePointer = 99
End
Begin StoneXP.XPButton XPButton4
Height = 375
Left = 6960
TabIndex = 2
Top = 6840
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "刪 除"
MouseIcon = "Form3.frx":0634
MousePointer = 99
End
Begin StoneXP.XPButton XPButton3
Height = 375
Left = 5640
TabIndex = 3
Top = 6840
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "修 改"
MouseIcon = "Form3.frx":094E
MousePointer = 99
End
Begin StoneXP.XPButton XPButton2
Height = 375
Left = 3000
TabIndex = 4
Top = 6840
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "保 存"
MouseIcon = "Form3.frx":0C68
MousePointer = 99
End
Begin StoneXP.XPButton XPButton1
Height = 375
Left = 1680
TabIndex = 5
Top = 6840
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "添 加"
MouseIcon = "Form3.frx":0F82
MousePointer = 99
End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim girdsav2 As Boolean
Dim gridedi2 As Boolean
Dim griddel2 As Boolean
Private Sub Form_Load()
On Error GoTo finish
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '進行注冊
With Grid1
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.Cols = 12
.DefaultFont.Name = "Tahoma"
.DefaultFont.Size = 8
.BackColorFixed = RGB(90, 158, 214)
.BackColorFixedSel = RGB(110, 180, 230)
.BackColorBkg = RGB(90, 158, 214)
.BackColorScrollBar = RGB(231, 235, 247)
.BackColor1 = RGB(231, 235, 247)
.BackColor2 = RGB(239, 243, 255)
.GridColor = RGB(148, 190, 231)
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.GridColor = RGB(148, 190, 231)
.DefaultFont.Name = "Tahoma"
.DefaultFont.Size = 8
.Column(0).Width = 0
.Column(1).Width = 30
.Column(2).Width = 100
.Column(3).Width = 50
.Column(4).Width = 100
.Column(5).Width = 100
.Column(6).Width = 100
.Column(7).Width = 80
.Column(8).Width = 80
.Column(9).Width = 80
End With
Call callmain
Grid1.Column(1).Locked = True
Grid1.Column(9).Locked = True
gridsav2 = False
gridedi2 = True
griddel2 = True
mdi = False
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
mdi = True
End Sub
Private Sub XPButton1_Click()
On Error GoTo finish
Grid1.Column(9).Locked = False
Set mdbrs = mdbconn.Execute("select * from 客戶信息")
Grid1.Rows = 1
Grid1.Rows = 2
Grid1.Column(1).Locked = True
Grid1.Cell(1, 2).SetFocus
gridsav2 = True
gridedi2 = False
griddel2 = False
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub XPButton2_Click()
'On Error GoTo finish
'If gridsav2 = False Then
'MsgBox "不支持保存操作！", vbInformation, "當前不支持"
'Exit Sub
'End If
Dim s6, s7, s8 As String
If Grid1.Cell(1, 2).Text = "" Then
MsgBox "單位名稱不可以是空格！", vbInformation, "錯誤提示"
Exit Sub
End If
If Grid1.Cell(1, 3).Text = "" Then
MsgBox "負責人不可以是空格！", vbInformation, "錯誤提示"
Exit Sub
End If
If Grid1.Cell(1, 4).Text = "" Then
MsgBox "請填寫單位地址！", vbInformation, "錯誤提示"
Exit Sub
End If
If Grid1.Cell(1, 5).Text = "" Then
MsgBox "請填寫聯系方式！", vbInformation, "錯誤提示"
Exit Sub
End If
If Grid1.Cell(1, 6).Text = "" Then
s6 = "-"
Else
s6 = Grid1.Cell(1, 6).Text
End If
If Grid1.Cell(1, 7).Text = "" Then
s7 = "-"
Else
s7 = Grid1.Cell(1, 7).Text
End If
If Grid1.Cell(1, 8).Text = "" Then
s8 = "-"
Else
s8 = Grid1.Cell(1, 8).Text
End If
Set mdbrs = mdbconn.Execute("select * from 客戶信息 where 單位名稱='" & Grid1.Cell(1, 2).Text & "'")
If mdbrs.EOF = True Then
Set mdbrs = mdbconn.Execute("insert into 客戶信息(單位名稱,負責人,地址,聯系方式,傳真號碼,郵件地址,郵編,預存款余額) values('" & Grid1.Cell(1, 2).Text & "','" & Grid1.Cell(1, 3).Text & "','" & Grid1.Cell(1, 4).Text & "','" & Grid1.Cell(1, 5).Text & "','" & s6 & "','" & s7 & "','" & s8 & "',val('" & Grid1.Cell(1, 9).Text & "'))")
MsgBox "提交成功！", vbInformation, ""
Call callmain
Else
MsgBox "該單位己存在！", vbInformation, "不可重名"
Exit Sub
End If
Grid1.Column(9).Locked = True
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub XPButton3_Click()
On Error GoTo finish
Dim s6, s7, s8 As String
If gridedi2 = False Then
MsgBox "當前修改操作不被允許!", vbInformation, "非使用對象"
Exit Sub
End If
For i = 1 To Grid1.Rows - 1
If Grid1.Cell(i, 6).Text = "" Then
s6 = "-"
Else
s6 = Grid1.Cell(i, 6).Text
End If
If Grid1.Cell(i, 7).Text = "" Then
s7 = "-"
Else
s7 = Grid1.Cell(i, 7).Text
End If
If Grid1.Cell(i, 8).Text = "" Then
s8 = "-"
Else
s8 = Grid1.Cell(i, 8).Text
End If
Set mdbrs = mdbconn.Execute("update 客戶信息 set 單位名稱='" & Grid1.Cell(i, 2).Text & "',負責人='" & Grid1.Cell(i, 3).Text & "',地址='" & Grid1.Cell(i, 4).Text & "',聯系方式='" & Grid1.Cell(i, 5).Text & "',傳真號碼='" & s6 & "',郵件地址='" & s7 & "',郵編='" & s8 & "',預存款余額=val('" & Grid1.Cell(i, 9).Text & "') where 客戶編號=val('" & Grid1.Cell(i, 1).Text & "')")
Next
MsgBox "修改的數據己經完成", vbInformation, "完成操作"
Call callmain
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub XPButton4_Click()
On Error GoTo finish
If griddel2 = False Then
MsgBox "當前刪除操作不被允許!", vbInformation, "非使用對象"
Exit Sub
End If
If hang = 0 Then
MsgBox "沒有選擇客戶或者沒有客戶可以刪除!", vbInformation, "非使用對象"
Exit Sub
End If
Set mdbrs = mdbconn.Execute("delete from 客戶信息 where 客戶編號=val('" & Grid1.Cell(hang, 1).Text & "')")
MsgBox "目標己刪除,請刷新數據!", vbInformation, "刪除成功"
Call callmain
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub XPButton5_Click()
Unload Me
End Sub
Private Sub callmain()
On Error GoTo finish
gridsav2 = False
gridedi2 = True
griddel2 = True
Set mdbrs = mdbconn.Execute("select * from 客戶信息")
Grid1.Rows = 1
i = 9
Grid1.Cols = i + 1
For i = 0 To 8
If i = 8 Then
Grid1.Cell(0, i + 1).Text = mdbrs.Fields(i).Name & "(元)"
Else
Grid1.Cell(0, i + 1).Text = mdbrs.Fields(i).Name
End If
Next
i = 1
Do While Not mdbrs.EOF
Grid1.Rows = Grid1.Rows + 1
For j = 1 To 9 '設定讀取列
If mdbrs.Fields(j - 1).Value = "-" Then '空值的處理
Grid1.Cell(i, j).Text = ""
Else
Grid1.Cell(i, j).Text = mdbrs.Fields(j - 1).Value
End If
Next
i = i + 1
mdbrs.MoveNext '讀取下一記錄
Loop
Grid1.Column(1).Locked = True
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
End Sub
Private Sub XPButton6_Click()
'On Error GoTo finish
If hang = 0 Then
MsgBox "請選擇客戶!", vbInformation, "非使用對象"
Exit Sub
End If
aa = InputBox("請輸入預存款金額:", "充值", 100, 500, 500)
If aa <> 0 Then
bb = aa + Val(Grid1.Cell(hang, 9).Text)
'MsgBox aa
Set mdbrs = mdbconn.Execute("select * from 客戶信息")
Grid1.Cell(hang, 9).Text = bb
i = hang
'Set mdbrs = mdbconn.Execute("update 客戶信息 set 預存款余額=val('" & Grid1.Cell(hang, 9) & "') where 單位名稱='" & Grid1.Cell(hang, 2).Text & "'")
Set mdbrs = mdbconn.Execute("update 客戶信息 set 單位名稱='" & Grid1.Cell(i, 2).Text & "',負責人='" & Grid1.Cell(i, 3).Text & "',地址='" & Grid1.Cell(i, 4).Text & "',聯系方式='" & Grid1.Cell(i, 5).Text & "',預存款余額=val('" & Grid1.Cell(i, 9).Text & "') where 客戶編號=val('" & Grid1.Cell(i, 1).Text & "')")
MsgBox "你本次的存款為:" & aa & "元 " & "你的預交款總額為:" & bb & "元", vbInformation, "充值成功!"
End If
Exit Sub
finish:
MsgBox Err.Description
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -