📄 frmkhgl.frm
字号:
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 210
TabIndex = 18
Top = 3120
Width = 3255
End
End
Begin VB.Frame Frame6
BackColor = &H80000018&
Height = 6105
Left = -74850
TabIndex = 7
Top = 360
Width = 6465
Begin VB.Frame Frame9
BackColor = &H80000018&
Caption = "合同"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3105
Left = 210
TabIndex = 9
Top = 210
Width = 6075
Begin XPControls.XPCommandButton cmdHTDel
Height = 345
Left = 4230
TabIndex = 10
Top = 2640
Width = 1005
_ExtentX = 1773
_ExtentY = 609
Caption = "删除"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPCommandButton cmdHTAdd
Height = 345
Left = 780
TabIndex = 11
Top = 2640
Width = 1005
_ExtentX = 1773
_ExtentY = 609
Caption = "添加"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPCommandButton cmdHTModify
Height = 345
Left = 2550
TabIndex = 12
Top = 2640
Width = 1005
_ExtentX = 1773
_ExtentY = 609
Caption = "修改"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSComctlLib.ListView lvwHT
Height = 2340
Left = 120
TabIndex = 13
Top = 240
Width = 5820
_ExtentX = 10266
_ExtentY = 4128
View = 3
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = 12648384
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 5
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "合同号"
Object.Width = 3528
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "起始时间"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "结束时间"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "合同金额"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "付款情况"
Object.Width = 0
EndProperty
End
End
Begin VB.TextBox TxtTYWLXXXJL
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2385
Left = 240
MultiLine = -1 'True
TabIndex = 8
Top = 3630
Width = 6045
End
Begin VB.Label Label28
BackStyle = 0 'Transparent
Caption = "业务联系详细记录："
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 14
Top = 3420
Width = 2325
End
End
End
End
Attribute VB_Name = "FrmKHGL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim menuOperation As OperationType
Private Sub cmdAdd_Click()
clearDWInfo
EnableInput True
cmdAdd.Enabled = False
cmdModify.Enabled = False
cmdSave.Enabled = True
cmdDelete.Enabled = False
menuOperation = Add
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdDelete_Click()
' Dim cmdTemp As ADODB.Command
' Dim strSQL As String
'
' If MsgBox("确认要删除该单位信息吗?", vbOKCancel, "确定") = vbOK Then
' Set cmdTemp = New ADODB.Command
' Set cmdTemp.ActiveConnection = GCon
' strSQL = "delete from SET_DW where DWID='" & lvwDW.SelectedItem & "'"
' cmdTemp.CommandText = strSQL
' cmdTemp.Execute
'
' strSQL = "delete from SET_DW_APPEND where DWID='" & lvwDW.SelectedItem & "'"
' cmdTemp.CommandText = strSQL
' cmdTemp.Execute
'
' strSQL = "delete from SET_DW_HT where DWID='" & lvwDW.SelectedItem & "'"
' cmdTemp.CommandText = strSQL
' cmdTemp.Execute
' End If
' RefreshDW
'
On Error GoTo ErrMsg
Dim Status
Dim strSQL As String
Dim cmd As ADODB.Command
Dim intIndex As Integer
Dim rstemp As ADODB.Recordset
Dim tmpYYID As String
Dim rsDX As ADODB.Recordset
'是否有选择
If lvwDW.SelectedItem Is Nothing Then
MsgBox "请在左侧的列表里面选择要删除的单位！", vbInformation, "提示"
Exit Sub
End If
If MsgBox("该操作不可恢复！" & vbCrLf & "确实要删除单位“" & txtTDWMC.Text & "”吗？" & vbCrLf _
& "该操作将删除该单位的所有体检数据及有与该单位有关的所有信息！", _
vbQuestion + vbYesNo + vbDefaultButton2, "警告") = vbNo Then Exit Sub
Me.MousePointer = vbHourglass
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = GCon
strSQL = "delete from SET_DW" _
& " where DWID='" & Mid(lvwDW.SelectedItem.Key, 2) & "'"
cmd.CommandText = strSQL
cmd.Execute
strSQL = "delete from SET_DW_Append" _
& " where DWID='" & Mid(lvwDW.SelectedItem.Key, 2) & "'"
cmd.CommandText = strSQL
cmd.Execute
strSQL = "delete from SET_DW_HT" _
& " where DWID='" & Mid(lvwDW.SelectedItem.Key, 2) & "'"
cmd.CommandText = strSQL
cmd.Execute
'删除该单位的人员，并删除该单位人员所有体检数据
Set rstemp = New ADODB.Recordset
strSQL = "select * from YY_TJDJ where DWID='" & Mid(lvwDW.SelectedItem.Key, 2) & "'"
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If rstemp.RecordCount > 0 Then
'暂存该单位的YYID
tmpYYID = rstemp("YYID")
'删除该单位的预约信息
strSQL = "delete from YY_TJDJ where DWID='" & Mid(lvwDW.SelectedItem.Key, 2) & "'"
cmd.CommandText = strSQL
cmd.Execute
'找出该单位所有人员的信息
strSQL = "select * from SET_GRXX where YYID='" & tmpYYID & "'"
Set rstemp = New ADODB.Recordset
rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
If rstemp.RecordCount > 0 Then
rstemp.MoveFirst
Do While Not rstemp.EOF
Set rsDX = New ADODB.Recordset
strSQL = "select DXPYSX from SET_DX where DXID in (select DXID from YY_SJDJDX where GUID=" & rstemp("GUID") & ")"
rsDX.Open strSQL, GCon, adOpenStatic, adLockReadOnly
'删除该人的体检数据
If rsDX.RecordCount > 0 Then
rsDX.MoveFirst
Do While Not rsDX.EOF
strSQL = "delete from [DATA_" & rsDX("DXPYSX") & "] where GUID=" & rstemp("GUID")
cmd.CommandText = strSQL
cmd.Execute
rsDX.MoveNext
Loop
'删除该人所登记的项目
strSQL = "delete from YY_SJDJDX where GUID=" & rstemp("GUID")
cmd.CommandText = strSQL
cmd.Execute
End If
rstemp.MoveNext
Loop
End If
'删除该单位的所有人在SET_GRXX中的数据
strSQL = "delete from SET_GRXX where YYID='" & tmpYYID & "'"
cmd.CommandText = strSQL
cmd.Execute
End If
intIndex = lvwDW.SelectedItem.Index
lvwDW.ListItems.Remove intIndex
If lvwDW.ListItems.Count >= 1 Then
If intIndex = 1 Then
Set lvwDW.SelectedItem = lvwDW.ListItems(intIndex)
Else
Set lvwDW.SelectedItem = lvwDW.ListItems(intIndex - 1)
End If
' Else
' ClearInput
End If
lvwDW_Click
Me.Mou⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -