基于accsess制作:
'Download by http://www.NewXing.com
Dim phoPath As String '照片路径
Dim tFlag As Integer 'text1索引标记
Dim SQL As String
Dim addlvwJTCY As ListItem '家庭成员
Dim addlvwGRJL As ListItem '个人简历
Dim addlvwSHRY As ListItem '所荣荣誉
Dim sx As Boolean '判断是否刷新
Private Sub cmdADDPHO_Click() '选择照片过程
Dim yPath As String '文件源路径
Dim newPath As String '新文件路径
If Me.Text1(0).Text = "" Or Me.Text1(1).Text = "" Then
MsgBox "请先录入编号、姓名然后再选择照片!", 64, "提示"
Exit Sub
End If
On erron GoTo Errline
Me.CommonDialog1.ShowOpen
yPath = Me.CommonDialog1.FileName
If yPath <> "" Then
newPath = App.Path & "\photos\" & Me.Text1(0).Text & Me.Text1(1).Text & ".jpg"
FileCopy yPath, newPath
Me.Image1.Picture = LoadPicture(newPath)
phoPath = "\photos\" & Me.Text1(0).Text & Me.Text1(1).Text & ".jpg"
End If
Exit Sub
Errline:
MsgBox "操作失败!", 48, "错误"
End Sub
Private Sub cmdDELPHO_Click()
Me.Image1.Picture = LoadPicture(App.Path & "\bg\000.jpg")
phoPath = ""
End Sub
Private Sub Combo1_Click() 'text1赋值
Me.Text1(tFlag).Text = Me.Combo1.Text
Me.Combo1.Visible = False
Me.Text1(tFlag + 1).SetFocus
End Sub
Private Sub Form_Initialize()
Call InitCommonControls 'XP效果
End Sub
Private Sub Form_Load()
Me.Caption = gXtmc
Me.Icon = MDIfrm.Icon '图标
If newFlag <> 0 Then '如果为修改
Call OpenConn
SQL = "select * from 基础档案表 where zgid=" & gXhcd
rs.Open SQL, cn, 1, 1
For i = 0 To 31
Me.Text1(i).Text = rs.Fields(i + 1)
Next
Me.Text1(32).Text = rs!建档人
'像片路径---------------
If rs!像片 <> "" Then
If Dir(App.Path & rs!像片) <> "" Then '判断像片是否存在
Me.Image1.Picture = LoadPicture(App.Path & rs!像片)
phoPath = rs!像片
End If
Else
Me.Image1.Picture = LoadPicture(App.Path & "\bg\000.jpg")
phoPath = ""
End If
'------------------------
Call CloseConn
Me.Toolbar1.Buttons(1).Visible = False '新增按钮不可用
Me.Toolbar1.Buttons(3).Enabled = False
Me.Toolbar1.Buttons(4).Enabled = False
Else '如果为新增
Me.Text1(32).Text = gCzy
Me.Toolbar1.Buttons(2).Visible = False '新增按钮不可用
Me.Toolbar1.Buttons(3).Enabled = False
Me.Toolbar1.Buttons(4).Visible = False
End If
'初始化家庭成员列表--------------------------------------------
With Me.lvwJTCY
.ColumnHeaders.Add = "职工姓名"
.ColumnHeaders.Add = "成员姓名"
.ColumnHeaders.Add = "关系"
.ColumnHeaders.Add = "所在单位"
.ColumnHeaders(1).Width = 2000
.ColumnHeaders(2).Width = 2000
.ColumnHeaders(3).Width = 2000
.ColumnHeaders(4).Width = 4700
End With
SQL1 = "select * from 家庭成员表 where czgid=" & gXhcd
Call OpenConn
rs.Open SQL1, cn, 1, 1
Do While Not rs.EOF
Set addlvwJTCY = Me.lvwJTCY.ListItems.Add(, , rs!职工姓名, , 1)
addlvwJTCY.SubItems(1) = rs!成员姓名
addlvwJTCY.SubItems(2) = rs!关系
addlvwJTCY.SubItems(3) = rs!所在单位
rs.MoveNext
Loop
Call CloseConn
'END-----------------------------------------------------------
'初始化个人简历列表--------------------------------------------
With Me.lvwGRJL
.ColumnHeaders.Add = "职工姓名"
.ColumnHeaders.Add = "开始时间"
.ColumnHeaders.Add = "结束时间"
.ColumnHeaders.Add = "所在单位"
.ColumnHeaders.Add = "职务"
.ColumnHeaders.Add = "证明人"
.ColumnHeaders(1).Width = 1500
.ColumnHeaders(2).Width = 1500
.ColumnHeaders(3).Width = 1500
.ColumnHeaders(4).Width = 3200
.ColumnHeaders(5).Width = 1500
.ColumnHeaders(6).Width = 1500
End With
SQL1 = "select * from 个人简历表 where jzgid=" & gXhcd
Call OpenConn
rs.Open SQL1, cn, 1, 1
Do While Not rs.EOF
Set addlvwGRJL = Me.lvwGRJL.ListItems.Add(, , rs!职工姓名, , 2)
addlvwGRJL.SubItems(1) = rs!开始时间
addlvwGRJL.SubItems(2) = rs!结束时间
addlvwGRJL.SubItems(3) = rs!所在单位
addlvwGRJL.SubItems(4) = rs!职务
addlvwGRJL.SubItems(5) = rs!证明人
rs.MoveNext
Loop
Call CloseConn
'END-----------------------------------------------------------
'初始所获荣誉列表--------------------------------------------
With Me.lvwSHRY
.ColumnHeaders.Add = "职工姓名"
.ColumnHeaders.Add = "获得时间"
.ColumnHeaders.Add = "所获称号"
.ColumnHeaders.Add = "颁发单位"
.ColumnHeaders(1).Width = 2000
.ColumnHeaders(2).Width = 2000
.ColumnHeaders(3).Width = 2000
.ColumnHeaders(4).Width = 4700
End With
SQL1 = "select * from 个人荣誉表 where rzgid=" & gXhcd
Call OpenConn
rs.Open SQL1, cn, 1, 1
Do While Not rs.EOF
Set addlvwSHRY = Me.lvwSHRY.ListItems.Add(, , rs!职工姓名, , 3)
addlvwSHRY.SubItems(1) = rs!获得时间
addlvwSHRY.SubItems(2) = rs!所获称号
addlvwSHRY.SubItems(3) = rs!颁发单位
rs.MoveNext
Loop
Call CloseConn
'END-----------------------------------------------------------
End Sub
Private Sub Form_Unload(Cancel As Integer)
If sx = True Then
frmJCDA.cmdSSSSSSX = True '刷新frmJCDA的listview
sx = False
End If
gXhcd = 0
End Sub
Private Sub Image1_DblClick()
If phoPath <> "" Then '双击以后用IE打开像片
Shell "explorer.exe " & App.Path & phoPath & "", vbNormalFocus
End If
End Sub
Private Sub Text1_GotFocus(Index As Integer) 'text1失去焦点过程,combo运行过程
Select Case Index
Case Is = 5 '性别
tFlag = 5
Me.Combo1.Width = Me.Text1(5).Width
Me.Combo1.Top = Me.Text1(5).Top
Me.Combo1.Left = Me.Text1(5).Left
Me.Combo1.Clear
Me.Combo1.AddItem "男"
Me.Combo1.AddItem "女"
Me.Combo1.Visible = True
'Me.Combo1.SetFocus
Case Is = 6 '婚否
tFlag = 6
Me.Combo1.Width = Me.Text1(6).Width
Me.Combo1.Top = Me.Text1(6).Top
Me.Combo1.Left = Me.Text1(6).Left
Me.Combo1.Clear
Me.Combo1.AddItem "未婚"
Me.Combo1.AddItem "已婚"
Me.Combo1.Visible = True
'Me.Combo1.SetFocus
Case Is = 8 '民族
tFlag = 8
Call addCOM(tFlag, "民族")
Case Is = 9 '政治面貌
tFlag = 9
Call addCOM(tFlag, "政治面貌")
Case Is = 12 '职工类型
tFlag = 12
Call addCOM(tFlag, "职工类型")
'------------------单位
Case Is = 13
tFlag = 13
Me.Combo1.Width = Me.Text1(13).Width
Me.Combo1.Top = Me.Text1(13).Top
Me.Combo1.Left = Me.Text1(13).Left
Me.Combo1.Clear
Call OpenConn
SQL = "select DISTINCT 单位名称 from 单位设置"
rs.Open SQL, cn, 1, 1
Do While Not rs.EOF
Me.Combo1.AddItem rs!单位名称
rs.MoveNext
Loop
Call CloseConn
Me.Combo1.Visible = True
Case Is = 14 '部门
tFlag = 14
Me.Combo1.Width = Me.Text1(14).Width
Me.Combo1.Top = Me.Text1(14).Top
Me.Combo1.Left = Me.Text1(14).Left
Me.Combo1.Clear
Call OpenConn
SQL = "select * from 单位设置 where 单位名称='" & Me.Text1(13).Text & "' and root=1"
rs.Open SQL, cn, 1, 1
Do While Not rs.EOF
Me.Combo1.AddItem rs!部门名称
rs.MoveNext
Loop
Call CloseConn
Me.Combo1.Visible = True
Case Is = 19
tFlag = 19
Call addCOM(tFlag, "学历")
Case Is = 20
tFlag = 20
Call addCOM(tFlag, "学历")
Case Is = 22
tFlag = 22
Call addCOM(tFlag, "岗位")
Case Is = 23
tFlag = 23
Call addCOM(tFlag, "岗别")
Case Is = 24
tFlag = 24
Call addCOM(tFlag, "档次")
Case Is = 25
tFlag = 25
Call addCOM(tFlag, "职务")
Case Is = 26
tFlag = 26
Call addCOM(tFlag, "职称")
Case Is = 27
tFlag = 27
Call addCOM(tFlag, "来源")
Case Is = 28
tFlag = 28
Call addCOM(tFlag, "用工形式")
Case Else
Me.Combo1.Visible = False
End Select
End Sub
Private Sub Text1_LostFocus(Index As Integer) 'text1失去焦点后检查编号是否重复,格式化日期
Select Case Index
Case Is = 0 '检查编号是否重复
Call OpenConn
SQL = "select 编号 from 基础档案表 where 编号='" & Me.Text1(0).Text & "'"
rs.Open SQL, cn, 1, 1
If rs.RecordCount > 0 Then
msg = MsgBox("该编号已经存在,是否继续?", vbYesNo + 64, "提示")
If msg = vbNo Then
Me.Text1(0).Text = ""
Me.Text1(0).SetFocus
End If
End If
Call CloseConn
Case Is = 11
'~~~~~~~~~~日期格式~~~~~~~~~~~~~~~~
If IsDate(Text1(11).Text) Then
Text1(11).Text = Format(Text1(11).Text, "yyyy-mm-dd")
Else
Text1(11) = ""
End If
Case Is = 17
If IsDate(Text1(17).Text) Then
Text1(17).Text = Format(Text1(17).Text, "yyyy-mm-dd")
Else
Text1(17) = ""
End If
Case Is = 18
If IsDate(Text1(18).Text) Then
Text1(18).Text = Format(Text1(18).Text, "yyyy-mm-dd")
Else
Text1(18) = ""
End If
Case Is = 29
If IsDate(Text1(29).Text) Then
Text1(29).Text = Format(Text1(29).Text, "yyyy-mm-dd")
Else
Text1(29) = ""
End If
Case Is = 30
If IsDate(Text1(30).Text) Then
Text1(30).Text = Format(Text1(30).Text, "yyyy-mm-dd")
Else
Text1(30) = ""
End If
End Select
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) '按钮组
Select Case Button.Key
Case Is = "tolXZ" '新增按钮
Me.Frame1.Enabled = True
For i = 0 To 31
Me.Text1(i).Text = ""
Next
Me.Image1.Picture = LoadPicture(App.Path & "\bg\000.jpg")
Me.Toolbar1.Buttons(1).Enabled = False '点击新增按钮后
Me.Toolbar1.Buttons(3).Enabled = True
Case Is = "tolXG" '修改按钮
Me.Frame1.Enabled = True
Me.Toolbar1.Buttons(2).Enabled = False
Me.Toolbar1.Buttons(3).Enabled = True
Me.Toolbar1.Buttons(4).Enabled = True
Case Is = "tolBC" '保存按钮
If Me.Text1(0).Text = "" Then
MsgBox "保存失败,编号不能为空!", 48, "错误"
Exit Sub
End If
If Me.Text1(1).Text = "" Then
MsgBox "保存失败,姓名不能为空!", 48, "错误"
Exit Sub
End If
If Me.Text1(12).Text = "" Then
MsgBox "保存失败,职工类型不能为空!", 48, "错误"
Exit Sub
End If
If Me.Text1(13).Text = "" Then
MsgBox "保存失败,职工所在单位不能为空!", 48, "错误"
Exit Sub
End If
If Me.Text1(14).Text = "" Then
MsgBox "保存失效,职工所在部门不能为空!", 48, "错误"
Exit Sub
End If
sx = True '是新增记录或是已经修改,需要刷新上一级窗体列表。
If newFlag = 0 Then '如果是新记录
Call OpenConn
SQL = "select * from 基础档案表"
rs.Open SQL, cn, 3, 3
rs.AddNew
For i = 0 To 31
rs.Fields(i + 1) = Me.Text1(i).Text
Next
rs!建档人 = Me.Text1(32).Text
rs!像片 = phoPath
rs.Update
Call CloseConn
phoPath = "" '清空像片路径
Me.Frame1.Enabled = False
MsgBox "记录添加成功!", 64, "提示"
Me.Toolbar1.Buttons(1).Enabled = True
Me.Toolbar1.Buttons(3).Enabled = False
Else '如果是修改记录
Call OpenConn
SQL = "select * from 基础档案表 where zgid=" & gXhcd
rs.Open SQL, cn, 3, 3
For i = 0 To 31
rs.Fields(i + 1) = Me.Text1(i).Text
Next
rs!建档人 = gCzy
rs!像片 = phoPath
rs.Update
Call CloseConn
Me.Frame1.Enabled = False
MsgBox "记录更新成功!", 64, "提示"
Me.Toolbar1.Buttons(2).Enabled = True
Me.Toolbar1.Buttons(3).Enabled = False
Me.Toolbar1.Buttons(4).Enabled = False
End If
Case Is = "tolSC" '删除按钮
msg = MsgBox("是否要删除该记录?", vbYesNo + 64, "提示")
If msg = vbYes Then
Call OpenConn
cn.Execute ("delete * from 基础档案表 where zgid=" & gXhcd)
Call CloseConn
MsgBox "记录删除成功!", 64, "提示"
Unload Me
End If
Case Is = "tolCSSZ" '参数设置按钮
frmXTSZ.Show 1
Case Is = "tolTC" '退出按钮
Unload Me
End Select
End Sub
Private Sub addCOM(indexFlag As Integer, SQLxm As String) 'combo位置、项目设置过程
Me.Combo1.Width = Me.Text1(indexFlag).Width
Me.Combo1.Top = Me.Text1(indexFlag).Top
Me.Combo1.Left = Me.Text1(indexFlag).Left
Me.Combo1.Clear
Call OpenConn
SQL = "select * from 参数设置表 where 项目='" & SQLxm & "'"
rs.Open SQL, cn, 1, 1
Do While Not rs.EOF
Me.Combo1.AddItem rs!值
rs.MoveNext
Loop
Call CloseConn
Me.Combo1.Visible = True
End Sub
Views: 38