📄 frm_计量器具台帐摸板.frm
字号:
_StyleDefs(27) = "Splits(0).OddRowStyle:id=21,.parent=10"
_StyleDefs(28) = "Splits(0).RecordSelectorStyle:id=23,.parent=11"
_StyleDefs(29) = "Splits(0).FilterBarStyle:id=24,.parent=12"
_StyleDefs(30) = "Splits(0).Columns(0).Style:id=28,.parent=13"
_StyleDefs(31) = "Splits(0).Columns(0).HeadingStyle:id=25,.parent=14"
_StyleDefs(32) = "Splits(0).Columns(0).FooterStyle:id=26,.parent=15"
_StyleDefs(33) = "Splits(0).Columns(0).EditorStyle:id=27,.parent=17"
_StyleDefs(34) = "Splits(0).Columns(1).Style:id=32,.parent=13"
_StyleDefs(35) = "Splits(0).Columns(1).HeadingStyle:id=29,.parent=14"
_StyleDefs(36) = "Splits(0).Columns(1).FooterStyle:id=30,.parent=15"
_StyleDefs(37) = "Splits(0).Columns(1).EditorStyle:id=31,.parent=17"
_StyleDefs(38) = "Named:id=33:Normal"
_StyleDefs(39) = ":id=33,.parent=0"
_StyleDefs(40) = "Named:id=34:Heading"
_StyleDefs(41) = ":id=34,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
_StyleDefs(42) = ":id=34,.wraptext=-1"
_StyleDefs(43) = "Named:id=35:Footing"
_StyleDefs(44) = ":id=35,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
_StyleDefs(45) = "Named:id=36:Selected"
_StyleDefs(46) = ":id=36,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
_StyleDefs(47) = "Named:id=37:Caption"
_StyleDefs(48) = ":id=37,.parent=34,.alignment=2"
_StyleDefs(49) = "Named:id=38:HighlightRow"
_StyleDefs(50) = ":id=38,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
_StyleDefs(51) = "Named:id=39:EvenRow"
_StyleDefs(52) = ":id=39,.parent=33,.bgcolor=&HFFFF00&"
_StyleDefs(53) = "Named:id=40:OddRow"
_StyleDefs(54) = ":id=40,.parent=33"
_StyleDefs(55) = "Named:id=41:RecordSelector"
_StyleDefs(56) = ":id=41,.parent=34"
_StyleDefs(57) = "Named:id=42:FilterBar"
_StyleDefs(58) = ":id=42,.parent=33"
End
Begin VB.Label Ljl
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "共查询到110条记录"
ForeColor = &H00008000&
Height = 180
Left = 7740
TabIndex = 49
Top = 1140
Width = 1530
End
Begin VB.Label Label22
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "计 量 器 具 基 础 台 帐"
BeginProperty Font
Name = "华文行楷"
Size = 21.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 450
Left = 2760
TabIndex = 1
Top = 270
Width = 4215
End
Begin VB.Line Line8
BorderColor = &H00000000&
X1 = -30
X2 = 9330
Y1 = 1380
Y2 = 1380
End
Begin VB.Line Line2
BorderColor = &H00E0E0E0&
X1 = -30
X2 = 5400
Y1 = 900
Y2 = 900
End
End
End
Attribute VB_Name = "Frm_计量器具台帐摸板"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As New ADODB.Recordset
Dim Add As Integer
Dim badd As Boolean
Dim Dwmc As String
Dim Jddw As String
Dim rscx As New ADODB.Recordset
Dim Cx_Sql_Str As String
Public Cxmc As String
Private Sub RsToText(rs As ADODB.Recordset)
On Error GoTo err
Tbh = Trim(rs!Bh)
Tmc = Trim(rs!Mc)
CZt.Text = Trim(rs!zt)
Clb.Text = Trim(rs!lb)
Czb.Text = Trim(rs!zb)
Cdj.Text = Trim(rs!dj)
Tggxh = Trim(rs!ggxh)
Tclfw = Trim(rs!clfw)
Tfdz = Trim(rs!fdz)
Tsccj = Trim(rs!sccj)
Tccbh = Trim(rs!ccbh)
Csybm.Text = Trim(rs!sybm)
Tsyz = Trim(rs!syz)
Tjdzq = Trim(rs!jdzq)
Czqdw.Text = Trim(rs!zqdw)
Dim rst As New ADODB.Recordset '提取检测信息
Dim str As String
If rst.State = 1 Then rst.Close
rst.CursorLocation = adUseClient
rst.Open "select max(bcjdrq) as jdrq from jlqjjd where bh='" & Trim(rs!Bh) & "'", Conn
If IsNull(rst!jdrq) = False Then
DTPjdrq.Value = rst!jdrq
rst.Close
rst.CursorLocation = adUseClient
rst.Open "select * from jlqjjd where bh='" & Trim(rs!Bh) & "' and bcjdrq=#" & DTPjdrq.Value & "#", Conn
If rst.EOF = False Then
Tjddw.Text = rst!Bcjddw
Tjdjg.Text = rst!bcjdjg
End If
Else
Tjddw = Trim(rs!Jddw)
Tjdjg = Trim(rs!jdjg)
DTPjdrq.Value = rs!jdrq
End If
DTPqyrq.Value = rs!qyrq
DTPbfrq.Value = rs!bfrq
Exit Sub
err:
MsgBox err.Description, vbCritical, "错误提示"
Exit Sub
End Sub
Private Sub CmdLl_Click()
On Error GoTo err
If Ck1.Value = 1 Then
Cx_Sql_Str = " select bh as 设备编号 , mc as 设备名称 , lb as 类别 , zb as 种别 , dj as 管理等级, zt as 设备状态, ggxh as 规格型号, clfw as 测量范围, fdz as 分度值, sccj as 生产厂家, ccbh as 出厂编号, sybm as 使用部门, syz as 使用者, qyrq as 起用日期, bfrq as 报废日期 ,cstr([jdzq])+[Zqdw] AS 检定周期,jddw as 检定单位 from jlqjxx " '+ " where "
Else
Cx_Sql_Str = " select bh as 设备编号 , mc as 设备名称 , lb as 类别 , zb as 种别 , dj as 管理等级, zt as 设备状态, ggxh as 规格型号, clfw as 测量范围, fdz as 分度值, sccj as 生产厂家, ccbh as 出厂编号, sybm as 使用部门, syz as 使用者, qyrq as 起用日期, bfrq as 报废日期 ,cstr([jdzq])+[Zqdw] AS 检定周期 ,jddw as 检定单位 from jlqjxx where dj <> '强制检定' "
End If
' For i = 1 To gridA.Rows - 1
' gridA.Row = 1
' rscx.Filter = "zdhy='" + Trim(gridA.TextMatrix(i, 1)) + "'"
' If Trim(gridA.TextMatrix(i, 3)) <> "null" Then
' Select Case Trim(rscx!sjlx)
' Case "字符"
' If Trim(gridA.TextMatrix(i, 2)) = "like" Then
' Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + "'%" + Trim(gridA.TextMatrix(i, 3)) + "%' " + Trim(gridA.TextMatrix(i, 4)) + " "
' Else
' Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + "'" + Trim(gridA.TextMatrix(i, 3)) + "' " + Trim(gridA.TextMatrix(i, 4)) + " "
' End If
' Case "数字"
' Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + Trim(gridA.TextMatrix(i, 3)) + " " + Trim(gridA.TextMatrix(i, 4)) + " "
' Case "日期"
' Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + "#" + Trim(gridA.TextMatrix(i, 3)) + "# " + Trim(gridA.TextMatrix(i, 4)) + " "
' End Select
' Else
' Cx_Sql_Str = Cx_Sql_Str + Trim(rscx!zdm) + " " + Trim(gridA.TextMatrix(i, 2)) + " " + Trim(gridA.TextMatrix(i, 3)) + " " + Trim(gridA.TextMatrix(i, 4)) + " "
'
' End If
' rscx.Filter = ""
' Next i
Grid.Visible = True
If rs.State = 1 Then rs.Close
rs.CursorLocation = adUseClient
rs.Open Cx_Sql_Str, Conn, adOpenStatic, adLockReadOnly
If rs.EOF = False Then SSTab1.Tab = 1
Ljl.Caption = "共查询到 " & rs.RecordCount & " 条记录"
Set Grid.DataSource = rs
Exit Sub
err:
MsgBox "查询条件错误!!", vbCritical, "提示"
SSTab1.Tab = 0
End Sub
Private Sub Command3_Click()
gridA.AddItem ""
gridA.TextMatrix(gridA.Rows - 1, 1) = Trim(rscx!zdhy)
End Sub
Private Sub Command4_Click()
If gridA.Row > 0 Then gridA.RemoveItem gridA.Row
End Sub
Private Sub DTPqyrq_Change()
DTPjdrq.Value = DTPqyrq.Value
End Sub
Private Sub Form_Load()
Me.Top = 100
Me.Left = 50
SSTab1.Tab = 0
Ljl.Caption = ""
Call grid_ini
If rscx.State = 1 Then rscx.Close
rscx.CursorLocation = adUseClient
rscx.Open "select * from cx_table where CXname='基本信息'", Conn
Set grid_zd.DataSource = rscx
End Sub
'Private Sub Grid_DblClick()
'On Error GoTo err
' If rs.State = 1 Then
' If rs.RecordCount > 0 Then
' If Trim(rs!设备编号) <> "" Then
' Tbh = Trim(rs!设备编号)
' Dim rst As New ADODB.Recordset
' If rst.State = 1 Then rst.Close
' rst.CursorLocation = adUseClient
' rst.Open "select * from jlqjxx where bh='" & Tbh & "'", Conn, adOpenStatic, adLockReadOnly
' If rst.EOF = False Then
' RsToText rst
' SSTab1.Tab = 2
' End If
' End If
' End If
' End If
' Exit Sub
'err:
' Exit Sub
'End Sub
Private Sub Grid_HeadClick(ByVal ColIndex As Integer)
Dim str As String
Dim st As String
str = Grid.Columns.Item(ColIndex).Caption
st = ""
Select Case str
Case "设备编号"
st = "bh"
Case "设备名称"
st = "mc"
Case "类别"
st = "lb"
Case "种别"
st = "zb"
Case "管理等级"
st = "dj"
Case "设备状态"
st = "zt"
Case "规格型号"
st = "ggxh"
Case "测量范围"
st = "clfw"
Case "分度值"
st = "fdz"
Case "生产厂家"
st = "sccj"
Case "出厂编号"
st = "ccbh"
Case "使用部门"
st = "sybm"
Case "使用者"
st = "syz"
Case "起用日期"
st = "qyrq"
Case "报废日期"
st = "bfrq"
Case "检定周期"
st = "zqdw, jdzq "
Case "检定单位"
st = "jddw"
End Select
If st = "" Then Exit Sub
If rs.State = 1 Then rs.Close
rs.CursorLocation = adUseClient
rs.Open Cx_Sql_Str & " order by " & st, Conn, adOpenStatic, adLockReadOnly
Set Grid.DataSource = rs
End Sub
Sub grid_ini()
gridA.ColComboList(2) = ">|>=|<|<=|=|<>|like|is"
gridA.ColComboList(4) = "AND|OR"
gridA.Rows = 1
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -