📄 frmygthgl.frm
字号:
Left = 555
TabIndex = 6
Top = 2985
Width = 1500
End
Begin MSComctlLib.ListView ListView1
Height = 2625
Left = 420
TabIndex = 5
Top = 3690
Width = 1965
_ExtentX = 3466
_ExtentY = 4630
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
Icons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.ComboBox Findbt
Height = 300
Left = 540
TabIndex = 4
Text = "查询项目"
Top = 2055
Width = 1440
End
Begin VB.TextBox Findnr
Height = 345
Left = 555
TabIndex = 3
Text = "查询条件"
Top = 2505
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "退会"
Height = 405
Left = 555
TabIndex = 2
Top = 825
Width = 1500
End
Begin VB.CommandButton Command3
Caption = "退出"
Height = 405
Left = 555
TabIndex = 1
Top = 1455
Width = 1500
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 0
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 32
ImageHeight = 32
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 12
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":00C2
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":1DCE
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":20F2
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":2FCE
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":3EAA
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":41CE
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":44F2
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":4816
Key = ""
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":4B3A
Key = ""
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":4E5E
Key = ""
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":5182
Key = ""
EndProperty
BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmYGTHGL.frx":54A6
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmYGTHGL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
If GH = "" Then
MsgBox "哪个员工需要退会!", vbInformation, "系统提示"
Else
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strsql As String
'strsql = "select * from YGJBZL"
strsql = "select * from YGJBZL where GH='" & GH & "'"
rs.Open strsql, gCnn, adOpenStatic, adLockOptimistic
If rs("GH") = 1 Then
MsgBox "该员工已经退会!", vbInformation, "系统提示"
Exit Sub
Else
If Not rs.EOF Then
If MsgBox("确定工号为：" & GH & " 的员工退会吗？", vbYesNo, "修改询问") = vbNo Then
Exit Sub
End If
End If
rs.Fields("TH") = 1
rs.Update
MsgBox "退会成功!!", vbInformation, "系统提示"
End If
End If
Exit Sub
End Sub
Private Sub Command2_Click()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim msg As String
Dim strsql As String
strsql = "select 工号,姓名 from VIEWYGXX"
If Trim(Findbt) <> "" And Trim(Findnr) <> "" Then
strsql = strsql & " where " & Findbt & " like '%" & Findnr & "%' "
End If
rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
If rs.RecordCount = 1 Then
Call FillText(Findbt, Findnr)
ElseIf rs.RecordCount > 1 Then
msg = ShowListView(ListView1, rs, False, 1000)
Else
ClearText
MsgBox "无记录", vbOKOnly, "系统提示"
End If
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub findnr_Click()
Findnr = ""
End Sub
Private Sub findnr_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
KL.Tab = 0
Command2_Click
End If
End Sub
Private Sub Form_Load()
If Me.WindowState = 0 Then Me.Move 0, 0, 10845, 6990
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim i As Long
rs.Open "select * from VIEWYGXX ", gCnn, adOpenStatic, adLockReadOnly
Findbt.Clear
For i = 0 To rs.Fields.count - 1
Findbt.AddItem rs.Fields(i).name
Next
End Sub
Private Sub FillText(code1 As String, code2 As String)
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strsql As String
On Error GoTo ErrHandle
strsql = "select * from VIEWYGXX "
strsql = strsql & " where " & Trim(code1) & " like '%" & Trim(code2) & "%'"
rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
If Not rs.EOF Then
GH = rs("工号")
XM = rs("姓名")
BM = rs("部门")
ZC = rs("职称")
CSNY = rs("出生年月")
If rs("性别") = True Then
XB.Item(0).Value = True
Else
XB.Item(1).Value = True
End If
HYZK = rs("婚姻状况")
YB = rs("邮编")
SFZH = rs("身份证号")
ADDRESS = rs("家庭住址")
GDDH = rs("固定电话")
SJ = rs("手机")
HJSZ = rs("户籍所在")
MZ = rs("民族")
WHCD = rs("文化程度")
RSRQ = rs("入司日期")
ZZMM = rs("政治面貌")
DLZH = rs("代理证号")
ZYZH = rs("展业证号")
JYJL = rs("教育经历")
GZJL = rs("工作经历")
JCJL = rs("奖惩记录")
PXJL = rs("培训记录")
LDDLRQ = rs("劳动合同或代理合同到期日期")
MEMO = rs("备注")
DBRXH = rs("担保人序号")
DBRXM = rs("担保人姓名")
DBRGZDW = rs("担保人工作单位")
DBRZC = rs("担保人职务")
DBRCSNY = rs("担保人出生年月")
If rs("担保人性别") = True Then
DBRXB.Item (0)
Else
DBRXB.Item (1)
End If
DBRBGDH = rs("担保人办公电话")
DBRYB = rs("担保人邮编")
DBRZZDH = rs("担保人住宅电话")
DBRADDRESS = rs("担保人家庭住址")
DBRSFZH = rs("担保人身份证号")
DBRSJ = rs("担保人手机")
DBRHJSZ = rs("担保人户籍地址")
DBRMQDZ = rs("担保人目前地址")
YBDBRGX = rs("与被担保人关系")
BZ = rs("担保人备注")
End If
Exit Sub
ErrHandle:
MsgBox Err.Description, vbCritical, "系统提示"
End Sub
Private Sub ClearText()
GH = ""
XM = ""
BM = ""
ZC = ""
CSNY = Now
XB.Item(0).Value = True
HYZK = ""
YB = ""
SFZH = ""
ADDRESS = ""
GDDH = ""
SJ = ""
HJSZ = ""
MZ = ""
WHCD = ""
RSRQ = Now
ZZMM = ""
DLZH = ""
ZYZH = ""
JYJL = ""
GZJL = ""
JCJL = ""
PXJL = ""
LDDLRQ = Now
MEMO = ""
DBRXH = ""
DBRXM = ""
DBRGZDW = ""
DBRZC = ""
DBRCSNY = Now
DBRXB.Item(0).Value = True
DBRBGDH = ""
DBRYB = ""
DBRZZDH = ""
DBRADDRESS = ""
DBRSFZH = ""
DBRSJ = ""
DBRHJSZ = ""
DBRMQDZ = ""
YBDBRGX = ""
DBRBZ = ""
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim i As Long
If ListView1.ListItems.count > 0 Then
For i = 1 To ListView1.ListItems.count
If ListView1.ListItems(i).Selected Then
Call FillText1(ListView1.ListItems(i).Text)
End If
Next
End If
End Sub
Private Sub FillText1(code1 As String)
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strsql As String
On Error GoTo ErrHandle
strsql = "select * from VIEWYGXX "
strsql = strsql & " where 工号" & " like '%" & Trim(code1) & "%'"
rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
If Not rs.EOF Then
GH = rs("工号")
XM = rs("姓名")
BM = rs("部门")
ZC = rs("职称")
CSNY = rs("出生年月")
If rs("性别") = True Then
XB.Item(0).Value = True
Else
XB.Item(1).Value = True
End If
HYZK = rs("婚姻状况")
YB = rs("邮编")
SFZH = rs("身份证号")
ADDRESS = rs("家庭住址")
GDDH = rs("固定电话")
SJ = rs("手机")
HJSZ = rs("户籍所在")
MZ = rs("民族")
WHCD = rs("文化程度")
RSRQ = rs("入司日期")
ZZMM = rs("政治面貌")
DLZH = rs("代理证号")
ZYZH = rs("展业证号")
JYJL = rs("教育经历")
GZJL = rs("工作经历")
JCJL = rs("奖惩记录")
PXJL = rs("培训记录")
LDDLRQ = rs("劳动合同或代理合同到期日期")
MEMO = rs("备注")
DBRXH = rs("担保人序号")
DBRXM = rs("担保人姓名")
DBRGZDW = rs("担保人工作单位")
DBRZC = rs("担保人职务")
DBRCSNY = rs("担保人出生年月")
If rs("担保人性别") = True Then
DBRXB.Item (0)
Else
DBRXB.Item (1)
End If
DBRBGDH = rs("担保人办公电话")
DBRYB = rs("担保人邮编")
DBRZZDH = rs("担保人住宅电话")
DBRADDRESS = rs("担保人家庭住址")
DBRSFZH = rs("担保人身份证号")
DBRSJ = rs("担保人手机")
DBRHJSZ = rs("担保人户籍地址")
DBRMQDZ = rs("担保人目前地址")
YBDBRGX = rs("与被担保人关系")
BZ = rs("担保人备注")
End If
Exit Sub
ErrHandle:
MsgBox Err.Description, vbCritical, "系统提示"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -