📄 frmbzb_ttdj.frm
字号:
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin XPControls.XPCommandButton cmdDelete
Height = 375
Left = 4095
TabIndex = 2
Top = 300
Width = 915
_ExtentX = 1614
_ExtentY = 661
Enabled = 0 'False
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 cmdOK
Height = 375
Left = 2865
TabIndex = 3
Top = 300
Width = 915
_ExtentX = 1614
_ExtentY = 661
Enabled = 0 'False
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 cmdAdd
Height = 375
Left = 405
TabIndex = 4
Top = 300
Width = 915
_ExtentX = 1614
_ExtentY = 661
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 cmdModify
Height = 375
Left = 1635
TabIndex = 5
Top = 300
Width = 915
_ExtentX = 1614
_ExtentY = 661
Enabled = 0 'False
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
End
Begin ResizeLibCtl.ReSize ReSize1
Left = 2940
Top = 6600
_Version = 131072
_ExtentX = 741
_ExtentY = 741
_StockProps = 0
Enabled = -1 'True
FormMinWidth = 0
FormMinHeight = 0
FormDesignHeight= 7665
FormDesignWidth = 10350
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1
Height = 7410
Left = 60
TabIndex = 39
Top = 150
Width = 3510
_ExtentX = 6191
_ExtentY = 13070
_Version = 393216
BackColor = 16777215
BackColorBkg = 12773886
TextStyleFixed = 1
SelectionMode = 1
AllowUserResizing= 3
RowSizingMode = 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
_NumberOfBands = 1
_Band(0).Cols = 2
End
End
Attribute VB_Name = "FrmBZB_TTDJ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim menuOperation As OperationType
Dim intGRSIndex As Integer
Dim arrYYID() As String '团体的预约ID数组，用于录入个人信息时使用
Dim arrFZ() As Integer '某团体的分组ID数组
Dim mblnReCheck As Boolean '是否复查
Private Const lngAffirm As Long = &H98FB98 '确认后的背景
Private Const lngNotAffirm As Long = &HCBC0FF ' &H29C153 '未确认后的背景
'**************************20040411加入 闻********************************
Dim mstrStatus As String '标识当前的操作状态
'**************************20040411加入完 闻********************************
Private Sub cmdAdd_Click()
On Error GoTo ErrMsg
Dim Status
Dim strSQL As String
Dim strHealthID As String '个人id
Dim strYYID As String '团体id
Dim rsTemp As ADODB.Recordset
Me.MousePointer = vbHourglass
ClearTTInput
'**************************20040411加入 闻********************************
mstrStatus = "add"
'**************************20040411加入完 闻********************************
'团体
'获取当前的最大编号
'获取当前最大的序列号
strYYID = Format(Date, "yyyymmdd")
strSQL = "select TJYYXLH from YY_XLH where RiQi='" & Date & "'"
Set rsTemp = New ADODB.Recordset
rsTemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
If rsTemp.RecordCount = 0 Then
strYYID = strYYID & "001"
ElseIf IsNull(rsTemp("TJYYXLH")) Then
strYYID = strYYID & "001"
rsTemp.Close
Else
strYYID = strYYID & LongToString(rsTemp("TJYYXLH") + 1, 3)
rsTemp.Close
End If
Set rsTemp = Nothing
txtTYYID.Text = strYYID
menuOperation = Add
SetAllInput True
cmdAdd.Enabled = False
cmdModify.Enabled = False
cmdOK.Enabled = True
'清除复查标志
mblnReCheck = False
GoTo ExitLab
ErrMsg:
Status = SetError(Err.Number, Err.Description, Err.Source)
ErrMsg Status
ExitLab:
Me.MousePointer = vbDefault
End Sub
Private Sub cmdCancel_Click()
Me.Hide
Unload Me
End Sub
Private Sub cmdDelete_Click()
On Error GoTo ErrMsg
Dim Status
Dim strSQL As String
Dim strID As String '个人id
Dim intGUID As Integer
Dim rsTemp As ADODB.Recordset
Dim i As Integer
'**************************20040411加入 闻********************************
mstrStatus = ""
'**************************20040411加入完 闻********************************
'是否有数据
If Me.MSHFlexGrid1.TextMatrix(1, 1) = "" Then Exit Sub
'检查是否可以删除
If Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 4) >= Date Then
MsgBox "您不能删除体检日期还未到来的客户！", vbInformation, "提示"
Exit Sub
End If
'提示
If MsgBox("该操作不可恢复！您确认要删除客户“" _
& Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 2) & "”吗？", _
vbQuestion + vbYesNo + vbDefaultButton2, "警告") = vbNo Then Exit Sub
'记录健康档案号或预约编号
strID = Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 1)
If Len(strID) = 11 Then
strSQL = "delete from YY_TJDJ" _
& " where YYID='" & strID & "'"
GCon.Execute strSQL
strSQL = "delete from FZ_FZSY where YYID='" & strID & "'"
GCon.Execute strSQL
strSQL = "delete from FZ_FZSJ where YYID='" & strID & "'"
GCon.Execute strSQL
strSQL = "delete from YY_TJDJDX where YYID='" & strID & "'"
GCon.Execute strSQL
strSQL = "delete from YY_TJDJTC where YYID='" & strID & "'"
GCon.Execute strSQL
End If
'重新加载数据
'初始化网格
With Me.MSHFlexGrid1
.Clear
.Rows = 2
.Cols = 5
'流水号
.TextMatrix(0, 0) = "流水号"
.ColWidth(0) = 0
.TextMatrix(0, 1) = "登记编号"
.ColWidth(1) = Me.TextWidth(.TextMatrix(0, 1)) + 200
.TextMatrix(0, 2) = "登记人"
.ColWidth(2) = Me.TextWidth(.TextMatrix(0, 2)) + 200
.TextMatrix(0, 3) = "团体名称"
.ColWidth(3) = Me.TextWidth(.TextMatrix(0, 3)) + 200
.TextMatrix(0, 4) = "体检日期"
.ColWidth(4) = Me.TextWidth(.TextMatrix(0, 4)) + 500
'显示尚未体检，但已经预约的个人或团体
'首先显示团体
strSQL = "select YYID,LXR,DWMC,TJRQ" _
& " from YY_TJDJ,SET_DW" _
& " where YY_TJDJ.DWID=SET_DW.DWID" _
& " and (SFTJ=0 or SFTJ=1)"
Set rsTemp = New ADODB.Recordset
rsTemp.Open strSQL, GCon, adOpenKeyset, adLockOptimistic
If rsTemp.RecordCount > 0 Then
rsTemp.MoveFirst
Do
If .TextMatrix(1, 1) = "" Then
i = 1
Else
i = .Rows
.Rows = i + 1
End If
.TextMatrix(i, 0) = ""
.TextMatrix(i, 1) = rsTemp("YYID")
.TextMatrix(i, 2) = rsTemp("LXR")
.TextMatrix(i, 3) = rsTemp("DWMC")
.TextMatrix(i, 4) = rsTemp("TJRQ")
If rsTemp("TJRQ") < Date Then
.Row = i
.col = 4
.CellBackColor = vbRed
End If
rsTemp.MoveNext
Loop Until rsTemp.EOF
rsTemp.Close
.Row = 1
.col = 0
.ColSel = 4
' MSHFlexGrid1_Click
End If
End With
MSHFlexGrid1_Click
Exit Sub
ErrMsg:
Status = SetError(Err.Number, Err.Description, Err.Source)
ErrMsg Status
End Sub
Private Sub cmdModify_Click()
'**************************20040411加入 闻********************************
' mstrStatus = "change"
'**************************20040411加入完 闻********************************
menuOperation = Modify
'团体
If txtTYYID.Text <> "" Then
SetAllInput True
cmbTDWei.Locked = True
cmdAdd.Enabled = False
cmdModify.Enabled = False
cmdOK.Enabled = True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -