📄 frmcard.frm
字号:
Height = 180
Index = 8
Left = 750
TabIndex = 30
Top = 2010
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "网址"
Height = 180
Index = 7
Left = 5340
TabIndex = 29
Top = 1620
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "E-mail"
Height = 180
Index = 6
Left = 930
TabIndex = 28
Top = 1620
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "传真"
Height = 180
Index = 5
Left = 5340
TabIndex = 27
Top = 840
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "手机"
Height = 180
Index = 4
Left = 1110
TabIndex = 26
Top = 1230
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "家庭电话"
Height = 180
Index = 3
Left = 4980
TabIndex = 25
Top = 1230
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "办公电话"
Height = 180
Index = 2
Left = 750
TabIndex = 24
Top = 840
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "单位"
Height = 180
Index = 1
Left = 3210
TabIndex = 23
Top = 450
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名"
Height = 180
Index = 0
Left = 1110
TabIndex = 22
Top = 450
Width = 360
End
End
End
Attribute VB_Name = "frmCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim I As Integer
Dim StrSql As String
Dim intCurrentRow As Integer
Dim intCurrentCol As Integer
Dim strAction As String
Dim intresult As Integer
Dim intRowClick As Integer
Const conActionNew = 0
Const conActionEdit = 1
Const conActionNormal = 2
Dim strEdit(1) As String
Dim intActionType As Integer
Dim oText As TextBox
Private Sub Cbo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeys "{tab}"
End If
Select Case KeyCode
Case 27
If intActionType <> 2 Then
Cancel_Click
Else
Unload Me
End If
Case 113
If intActionType <> 2 Then CmdSave_Click
Case 45
If intActionType = 2 Then CmdIns_Click
End Select
End Sub
Private Sub CmdDel_Click()
Dim j As Integer
On Error GoTo ErrorHandle
If MSFlex.Rows = 2 And MSFlex.TextMatrix(1, 1) = "" And MSFlex.TextMatrix(1, 2) = "" Then
Exit Sub
End If
intresult = MsgBox("是否真要删除当前记录，请慎重操作！ ", vbYesNo + vbQuestion + vbDefaultButton2, "删除操作")
If intresult = vbYes Then
StrSql = "Delete from c002 Where f001 = '" & Trim(Text1(0)) & "' and f002='" & Trim(Text1(1)) & "'"
adoCon.Errors.Clear
On Error GoTo ErrorHandle
adoCon.Execute (StrSql)
On Error GoTo 0
If MSFlex.Rows = 2 Then
MSFlex.HighLight = flexHighlightNever
For Each oText In Me.Text1
oText.Text = ""
Next
I = 1
For j = 1 To MSFlex.Cols - 1
MSFlex.TextMatrix(I, j) = ""
Next
MSFlex_RowColChange
MSFlex.Enabled = False
Else
MSFlex.RemoveItem intCurrentRow
intCurrentRow = 0
MSFlex_RowColChange
intCurrentRow = MSFlex.Row
End If
End If
Exit Sub
ErrorHandle:
MsgBox "错误 # " & Str(Err.Number) & " 生成于 " & Err.Source & Chr(13) & Err.Description, vbCritical, "错误" & "DEL_CLICK", Err.HelpFile, Err.HelpContext
End Sub
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub CmdIns_Click()
For Each oText In Me.Text1
oText.Text = ""
Next
Text1(0).SetFocus
MSFlex.Enabled = False
CmdSave.Enabled = True
CmdIns.Enabled = False
CmdModi.Enabled = False
CmdDel.Enabled = False
CmdQry.Enabled = False
intActionType = conActionNew
Cbo1 = "商业客户"
End Sub
Private Sub CmdModi_Click()
If MSFlex.Rows = 2 And MSFlex.TextMatrix(1, 1) = "" And MSFlex.TextMatrix(1, 2) = "" Then
Exit Sub
End If
strEdit(0) = Trim(Text1(0))
strEdit(1) = Trim(Text1(1))
MSFlex.Enabled = False
CmdSave.Enabled = True
Text1(0).SetFocus
intActionType = conActionEdit
End Sub
Private Sub CmdQry_Click()
Dim adoRes As New ADODB.Recordset
On Error GoTo ErrorHandle
If CmdQry.Caption = "查询" Then
CmdQry.Caption = "执行"
For Each oText In Me.Text1
oText.Text = ""
Cbo1 = ""
Next
Text1(0).SetFocus
Exit Sub
End If
If CmdQry.Caption = "执行" Then
CmdQry.Caption = "查询"
End If
StrSql = "select * from c002 where "
For I = 0 To 13
If Len(Trim(Text1(I))) > 0 And I < 9 Then
StrSql = StrSql & " f00" & I + 1 & " Like " & " '" & "%" & Trim(Text1(I)) & "%" & "'" & " and"
End If
If Len(Trim(Text1(I))) > 0 And I >= 9 Then
StrSql = StrSql & " f0" & I + 1 & " Like " & " '" & "%" & Trim(Text1(I)) & "%" & "'" & " and"
End If
Next
If Len(Trim(Cbo1)) > 0 Then
StrSql = StrSql & " f015 like " & "'" & "%" & Lov_list("c003", "f002", "f001", Cbo1) & "%" & "'" & " and"
End If
StrSql = Mid(StrSql, 1, Len(Trim(StrSql)) - 3) & " order by f001"
Me.MousePointer = vbHourglass
Set adoRes = adoCon.Execute(StrSql)
If adoRes.EOF Then
MsgBox "没有查询到记录，请重新输入条件！ ", vbOKOnly + vbInformation, "信息帮助"
Text1(0).SetFocus
MSFlex.Enabled = False
Me.MousePointer = flexDefault
Exit Sub
End If
FillGrid MSFlex, adoRes
MSFlex.Enabled = True
MSFlex.SetFocus
MSFlex_RowColChange
CmdSave.Enabled = False
Me.MousePointer = flexDefault
Exit Sub
ErrorHandle:
Me.MousePointer = flexDefault
MsgBox "错误 # " & Str(Err.Number) & " 生成于 " & Err.Source & Chr(13) & Err.Description, vbCritical, "错误" & "FIND_CLICK", Err.HelpFile, Err.HelpContext
End Sub
Private Sub CmdSave_Click()
Dim I, j As Integer
Dim Index As Integer
Dim TT As String
Dim TT2 As String
Select Case CmdSave.Caption
Case "存盘"
If Len(Trim(Text1(0))) = 0 Then
MsgBox "姓名不能为空！请输入！！！ ", vbOKOnly + vbExclamation, "信息帮助"
Text1(0).SetFocus
Exit Sub
End If
If Len(Trim(Text1(1))) = 0 Then
MsgBox "单位不能为空！请输入！！！ ", vbOKOnly + vbExclamation, "信息帮助"
Text1(1).SetFocus
Exit Sub
End If
Select Case intActionType
Case conActionNew
StrSql = "INSERT INTO c002(f001,f002,f003,f004,f005,f006,f007,f008,f009,f010,f011,f012,f013,f014,f015)" _
& " VALUES('" & Trim(Text1(0)) & "','" & Trim(Text1(1)) & "','" & Trim(Text1(2)) & "','" & Trim(Text1(3)) & "','" _
& Trim(Text1(4)) & "','" & Trim(Text1(5)) & "','" & Trim(Text1(6)) & "','" & Trim(Text1(7)) & "','" _
& Trim(Text1(8)) & "','" & Trim(Text1(9)) & "','" & Trim(Text1(10)) & "','" & Trim(Text1(11)) & "','" _
& Trim(Text1(12)) & "','" & Trim(Text1(13)) & "','" _
& IIf(Len(Lov_list("c003", "f002", "f001", Trim(Cbo1))) = 0, "", Lov_list("c003", "f002", "f001", Trim(Cbo1))) & "')"
On Error GoTo ErrorHandle
'MsgBox StrSql
adoCon.Execute StrSql
On Error GoTo 0
With MSFlex
.Enabled = True
.Tag = True
If Not (.Rows = 2 And .TextMatrix(1, 1) = "" And .TextMatrix(1, 2) = "") Then
.AddItem ("")
End If
For I = 1 To 15
.ColAlignment(I) = flexAlignLeftCenter
If I = 15 Then
.TextMatrix(.Rows - 1, I - 1) = Cbo1
ElseIf I = 14 Then
.TextMatrix(.Rows - 1, I + 1) = IIf(IsNull(Trim(Text1(I - 1))), "", Trim(Text1(I - 1)))
Else
.TextMatrix(.Rows - 1, I) = IIf(IsNull(Trim(Text1(I - 1))), "", Trim(Text1(I - 1)))
End If
Next I
intCurrentRow = .Rows - 1
intCurrentCol = 0
.ColSel = .Cols - 1
.Row = .Rows - 1
.ColSel = .Cols - 1
.TopRow = .Rows - 1
.SetFocus
End With
MSFlex.Row = MSFlex.Rows - 1
MSFlex_RowColChange
intActionType = conActionNormal
Case conActionEdit
StrSql = "UPDATE c002 SET " _
& "f001= '" & Trim(Text1(0)) & "'," _
& "f002= '" & Trim(Text1(1)) & "'," _
& "f003= '" & Trim(Text1(2)) & "'," _
& "f004= '" & Trim(Text1(3)) & "'," _
& "f005= '" & Trim(Text1(4)) & "'," _
& "f006= '" & Trim(Text1(5)) & "'," _
& "f007= '" & Trim(Text1(6)) & "'," _
& "f008= '" & Trim(Text1(7)) & "'," _
& "f009= '" & Trim(Text1(8)) & "'," _
& "f010= '" & Trim(Text1(9)) & "'," _
& "f011= '" & Trim(Text1(10)) & "'," _
& "f012= '" & Trim(Text1(11)) & "'," _
& "f013= '" & Trim(Text1(12)) & "'," _
& "f014= '" & Trim(Text1(13)) & "'," _
& "f015= '" & IIf(Len(Lov_list("c003", "f002", "f001", "" & Trim(Cbo1) & "")) = 0, "", Lov_list("c003", "f002", "f001", "" & Trim(Cbo1) & "")) & "'" _
& " where f001='" & strEdit(0) & "' and f002='" & strEdit(1) & "'"
'MsgBox StrSql
On Error GoTo ErrorHandle
adoCon.Execute StrSql
On Error GoTo 0
With MSFlex
For I = 1 To 15
.ColAlignment(I) = flexAlignLeftCenter
If I = 15 Then
.TextMatrix(.Rows - 1, I - 1) = Cbo1
ElseIf I = 14 Then
.TextMatrix(.Row, I + 1) = IIf(IsNull(Trim(Text1(I - 1))), "", Trim(Text1(I - 1)))
Else
.TextMatrix(.Row, I) = IIf(IsNull(Trim(Text1(I - 1))), "", Trim(Text1(I - 1)))
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -