📄 frminfo.frm
字号:
TabIndex = 17
Top = 240
Width = 1455
_ExtentX = 2566
_ExtentY = 450
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Value = 1
Caption = "显示人数"
End
Begin VB.Image imgPic
Height = 255
Index = 0
Left = 60
Top = 200
Width = 255
End
End
Begin VB.Frame fraFind
Height = 600
Left = 0
TabIndex = 4
Top = 600
Width = 9495
Begin VB.ComboBox cboFind
Height = 300
Index = 0
ItemData = "frmInfo.frx":33A7
Left = 360
List = "frmInfo.frx":33B4
Style = 2 'Dropdown List
TabIndex = 9
Top = 200
Width = 1815
End
Begin VB.ComboBox cboFind
Height = 300
Index = 2
ItemData = "frmInfo.frx":33E0
Left = 4080
List = "frmInfo.frx":33F9
Style = 2 'Dropdown List
TabIndex = 8
Top = 200
Width = 1695
End
Begin VB.TextBox txtFind
Height = 300
Left = 5820
TabIndex = 6
Top = 200
Width = 2775
End
Begin VB.ComboBox cboFind
Height = 300
Index = 1
Left = 2220
Style = 2 'Dropdown List
TabIndex = 5
Top = 200
Width = 1815
End
Begin Manage.xpcmdButton cmdFind
Height = 345
Left = 8660
TabIndex = 12
Top = 180
Width = 735
_ExtentX = 1296
_ExtentY = 609
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "查询"
ForeColor = -2147483630
End
Begin VB.Image imgPic
Height = 255
Index = 1
Left = 60
Top = 200
Width = 255
End
End
Begin Manage.ctxHookMenu cmuMain
Left = 0
Top = 0
_ExtentX = 900
_ExtentY = 900
BmpCount = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Menu mnuPopUp
Caption = "popMenu"
Index = 0
Visible = 0 'False
Begin VB.Menu mnuPopMenuA
Caption = "部门编辑(&E)..."
Index = 0
End
Begin VB.Menu mnuPopMenuA
Caption = "属性(&R)"
Index = 1
End
End
Begin VB.Menu mnuPopUp
Caption = "popMenu"
Index = 1
Visible = 0 'False
Begin VB.Menu mnuPopMenuB
Caption = "企业信息(&R)..."
Index = 0
End
Begin VB.Menu mnuPopMenuB
Caption = "部门编辑(&E)..."
Index = 1
End
Begin VB.Menu mnuPopMenuB
Caption = "住宿管理(&F)"
Index = 2
End
End
Begin VB.Menu mnuArchives
Caption = "系统(&S)"
Begin VB.Menu mnuPrint
Caption = "打印..."
Shortcut = ^P
End
Begin VB.Menu mnuLine4
Caption = "-"
End
Begin VB.Menu mnuOut
Caption = "导出资料..."
Shortcut = ^O
End
Begin VB.Menu mnuLine1
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "退出"
Shortcut = ^Q
End
End
Begin VB.Menu mnuManage
Caption = "编辑(&E)"
Begin VB.Menu mnuEdit
Caption = "企业信息"
Index = 0
Shortcut = ^R
End
Begin VB.Menu mnuEdit
Caption = "隶属部门"
Index = 1
Shortcut = ^E
End
Begin VB.Menu mnuEdit
Caption = "住宿管理"
Index = 2
Shortcut = ^F
End
Begin VB.Menu mnuBasic
Caption = "基本数据"
Shortcut = ^D
End
End
End
Attribute VB_Name = "frmInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'04-12-26修正3个小错误
Option Explicit
Dim adoCallLink As New ADODB.Recordset '连接选择框中显示的数据
Dim adoTempLink As New ADODB.Recordset
Dim intPopulace As Integer
Dim strhead(1) As String
Dim intTemp As Integer
Dim intButton As Integer
Dim intLine(1) As Integer
Dim strColName As String
Dim strSelect As String
Dim strFrm As String
Dim blnChk As Boolean
Private Sub cboFind_Click(Index As Integer)
If Index <> 0 Then Exit Sub
On Error GoTo errNext
cboFind(1).Clear
Select Case cboFind(0).ListIndex
Case 0: '详细资料
cboFind(2).Visible = True
txtFind.ToolTipText = "请输入查询内容"
intLine(0) = 5820
intLine(1) = 6760
Dim intTemp As Integer
With adoTempLink
If .State = adStateOpen Then .Close
.Open "select * from v员工详细资料", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
intTemp = .Fields.Count - 1
For intCount = 1 To intTemp
cboFind(1).AddItem .Fields(intCount).Name, intCount - 1
Next
End With
Case 1: '合同
cboFind(2).Visible = False
intLine(0) = 4080
intLine(1) = 5020
txtFind.ToolTipText = "请输入终止年份"
'txtFind.Text = intHYear & "-" & intHMonth & "-" & intHday
cboFind(1).AddItem "到期(年-月-日)", 0
cboFind(1).AddItem "所有", 1
txtFind.Text = CDate(Year(Now) & "-" & Month(Now) & "- " & Day(Now))
Case 2: '试用期
cboFind(2).Visible = False
intLine(0) = 4080
intLine(1) = 5020
txtFind.ToolTipText = "请输入试用月数"
'txtFind.Text = intMonth
cboFind(1).AddItem "到期(月数)", 0
cboFind(1).AddItem "所有", 1
txtFind.Text = 1
End Select
cboFind(1).ListIndex = 0
cboFind(2).ListIndex = 0
txtFind.Left = intLine(0)
txtFind.Width = fraFind.Width - intLine(1)
'txtFind.Text = ""
Exit Sub
errNext:
Call ErrMsg(Err.Number, Err.Description)
End Sub
Private Sub chkCount_Click()
chkCount.Enabled = False
If chkCount.Value = 0 Then
blnChk = True
Else
blnChk = False
End If
Call AddTreeView
chkCount.Enabled = True
End Sub
Private Sub chkUp_Click()
If chkUp.Value = 0 Then
strhead(1) = "DESC"
Else
strhead(1) = ""
End If
End Sub
Private Sub cmdButton_Click(Index As Integer)
On Error GoTo errNext
Select Case Index
Case 0:
gblnAdd = True
frmEdit.Show vbModal, Me
Case 1:
Call dgdmain_DblClick
Case 2:
If adoCallLink.EOF = True Then MsgBox "删除时发生错误,未找到指定的记录!", vbInformation, App.Title: Exit Sub
strString(0) = Trim(adoCallLink.Fields("员工编号") & "")
strString(1) = Trim(adoCallLink.Fields("姓名") & "")
strString(2) = Trim(adoCallLink.Fields("隶属部门") & "")
If MsgBox("确认要删除隶属部门[" & strString(2) & "],编号[" & strString(0) & "],姓名[" & strString(1) & "]的员工吗?", vbInformation + vbYesNo, App.Title) = vbYes Then
With adoTempLink
If .State = adStateOpen Then .Close
.Open "select 员工编号 from 员工详细资料 where 员工编号='" & strString(0) & "'", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
.Delete
.MoveNext
intPopulace = intPopulace - 1
If intPopulace = 0 Then cmdButton(1).Enabled = False: cmdButton(2).Enabled = False
adoCallLink.Requery
ricBox.Text = ricBox.Text & "时间: " & Now & " 内容: 删除员工,隶属部门[" & strString(2) & "],编号[" & strString(0) & "],姓名[" & strString(1) & "]." & vbCrLf
Call AddTreeView
strString(0) = ""
strString(1) = ""
strString(2) = ""
MsgBox "删除成功!", vbInformation, App.Title
Else
MsgBox "删除时发生错误,未找到指定的记录!", vbInformation, App.Title
End If
End With
End If
Case 3:
Unload Me
End Select
Exit Sub
errNext:
Call ErrMsg(Err.Number, Err.Description)
End Sub
Private Sub dgdmain_DblClick()
On Error Resume Next
With adoCallLink
If .EOF = True Then Exit Sub
strString(0) = Trim(.Fields("员工编号") & "")
strString(1) = Trim(.Fields("姓名") & "")
strString(2) = Trim(.Fields("隶属部门") & "")
strString(3) = .Fields("id")
End With
gblnAdd = False
frmEdit.Show vbModal, Me
End Sub
Private Sub dgdmain_HeadClick(ByVal ColIndex As Integer)
strhead(0) = dgdmain.Columns(ColIndex).Caption & " " & strhead(1)
Call ManageLoad(intTemp)
End Sub
Private Sub dgdmain_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call dgdmain_DblClick
End Sub
Public Sub AddTreeView()
Dim intTemp(1) As Integer
Dim strTempNode() As String
Dim strTempName() As String
Dim intCount As Integer
On Error GoTo ErrHandle
tvwManage.Visible = False
With adoLink
If .State = adStateOpen Then .Close
tvwManage.Nodes.Clear
tvwManage.Nodes.Add , , "A", gstrCro, 1
intTemp(0) = 1 '记录层次
intTemp(1) = 1
nodLong(0) = 1
strTemp(0) = "C"
strTemp(1) = "A"
.Open "select * from 隶属部门 order by 层次,部门编号,id", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
If .EOF = False Then
.MoveLast
gintManageCount = .RecordCount
ReDim strTempNode(gintManageCount): ReDim strTempName(gintManageCount)
.MoveFirst
Do Until .EOF
If intTemp(0) <> .Fields("层次") Then
nodLong(0) = 1
strTemp(0) = strTemp(0) & "C"
strTemp(1) = strTemp(0) & (nodLong(0))
intTemp(0) = intTemp(0) + 1
End If
strTempNode(intTemp(1)) = strTemp(0) & nodLong(0)
strTempName(intTemp(1)) = .Fields("隶属部门")
For intCount = 1 To intTemp(1)
If .Fields("上层部门") = strTempName(intCount) Then
strTemp(2) = strTempNode(intCount)
Exit For
Else
strTemp(2) = strTemp(1)
End If
Next
tvwManage.Nodes.Add strTemp(2), tvwChild, strTemp(0) & nodLong(0), Trim(!隶属部门), intTemp(0) + 1
nodLong(0) = nodLong(0) + 1
intTemp(1) = intTemp(1) + 1
.MoveNext
Loop
End If
If blnChk = True Then
With adoTempLink '读取有多少员工在这个部门
If .State = adStateOpen Then .Close '读取有多少员工在这个部门
.Open "SELECT a.id,a.层次,a.部门编号,count(b.隶属部门) as 数量 FROM 隶属部门 a LEFT OUTER JOIN 员工详细资料 b ON a.id = b.隶属部门 group BY a.层次,a.部门编号,a.id,b.隶属部门 order by a.层次,a.部门编号,a.id", adoConn, adOpenDynamic, adLockPessimistic, adCmdText
intCount = 1
Do Until .EOF
intCount = intCount + 1
tvwManage.Nodes(intCount).Text = tvwManage.Nodes(intCount).Text & "(" & .Fields("数量") & ")"
.MoveNext
Loop
End With
tvwManage.Nodes("A").Text = tvwManage.Nodes("A").Text & "(" & gintManCount & ")"
End If
tvwManage.Nodes("A").Expanded = True
End With
tvwManage.Visible = True
staInfo.Panels(2).Text = "公司部门数:" & gintManageCount & "个"
staInfo.Panels(3).Text = "公司员工数:" & gintManCount & "个"
Exit Sub
ErrHandle:
tvwManage.Visible = True
MsgBox "错误：" & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbExclamation, "运行错误"
End Sub
Private Sub cmdFind_Click()
Dim strTemp As String
On Error GoTo errNext
Select Case cboFind(0).ListIndex
Case 0: '详细资料⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -