?? frm_計(jì)量器具臺(tái)帳本月新啟用.frm
字號(hào):
Private Sub CmdPri_Click()
If Frame1.Visible = False Then Frame1.Visible = True
If rsls.State = 1 Then rsls.Close
Set GridPri.DataSource = Nothing
rsls.CursorLocation = adUseClient
rsls.Open "select * from pri where bm='基本信息'", Conn, adOpenDynamic, adLockBatchOptimistic
Set GridPri.DataSource = rsls
Frame1.Visible = True
End Sub
Private Sub Command1_Click()
On Error GoTo ERR
Dim D1 As String
Dim D2 As String
D1 = Format(Text1.Text, "0000") & "-" & Format(Text2.Text, "00") & "-" & "01"
If Format(Text2.Text, "00") = "12" Then
D2 = Format(CStr(CInt(Text1.Text) + 1), "0000") & "-01-01"
Else
D2 = Format(Text1.Text, "0000") & "-" & Format(CStr(CInt(Text2.Text) + 1), "00") & "-" & "01"
End If
Dim st As String
st = "select"
If rsls.State <> 1 Then Exit Sub
rsls.Filter = "xd=1"
If rsls.RecordCount < 1 Then Exit Sub
rsls.MoveFirst
Do While rsls.EOF = False
Select Case rsls!zdm
Case "設(shè)備編號(hào)"
If st = "select" Then
st = st & " bh as 設(shè)備編號(hào) "
Else
st = st & ", bh as 設(shè)備編號(hào)"
End If
Case "設(shè)備名稱"
If st = "select" Then
st = st & " mc as 設(shè)備名稱 "
Else
st = st & ", mc as 設(shè)備名稱 "
End If
Case "類別"
If st = "select" Then
st = st & " lb as 類別 "
Else
st = st & ", lb as 類別"
End If
Case "種別"
If st = "select" Then
st = st & " zb as 種別 "
Else
st = st & ", zb as 種別"
End If
Case "管理等級(jí)"
If st = "select" Then
st = st & " dj as 管理等級(jí) "
Else
st = st & ", dj as 管理等級(jí)"
End If
Case "設(shè)備狀態(tài)"
If st = "select" Then
st = st & " zt as 設(shè)備狀態(tài) "
Else
st = st & ", zt as 設(shè)備狀態(tài) "
End If
Case "規(guī)格型號(hào)"
If st = "select" Then
st = st & " ggxh as 規(guī)格型號(hào) "
Else
st = st & ", ggxh as 規(guī)格型號(hào)"
End If
Case "測(cè)量范圍"
If st = "select" Then
st = st & " clfw as 測(cè)量范圍 "
Else
st = st & ", clfw as 測(cè)量范圍"
End If
Case "分度值"
If st = "select" Then
st = st & " fdz as 分度值 "
Else
st = st & ", fdz as 分度值"
End If
Case "生產(chǎn)廠家"
If st = "select" Then
st = st & " sccj as 生產(chǎn)廠家 "
Else
st = st & ", sccj as 生產(chǎn)廠家"
End If
Case "出廠編號(hào)"
If st = "select" Then
st = st & " ccbh as 出廠編號(hào) "
Else
st = st & ", ccbh as 出廠編號(hào)"
End If
Case "使用部門"
If st = "select" Then
st = st & " sybm as 使用部門 "
Else
st = st & ", sybm as 使用部門"
End If
Case "使用者"
If st = "select" Then
st = st & " syz as 使用者 "
Else
st = st & ", syz as 使用者"
End If
Case "啟用日期"
If st = "select" Then
st = st & " qyrq as 啟用日期 "
Else
st = st & ", qyrq as 啟用日期"
End If
Case "檢定周期"
If st = "select" Then
st = st & " cstr([jdzq])+[Zqdw] AS 檢定周期"
Else
st = st & ", cstr([jdzq])+[Zqdw] AS 檢定周期"
End If
Case "檢定單位"
If st = "select" Then
st = st & " jddw as 檢定單位 "
Else
st = st & ",jddw as 檢定單位"
End If
End Select
rsls.MoveNext
Loop
rsls.Filter = ""
rsls.UpdateBatch adAffectAllChapters
st = st & " from jlqjxx where qyrq>=#" & D1 & "# and qyrq <#" & D2 & "# order by qyrq "
If rsPri.State = 1 Then rsPri.Close
rsPri.CursorLocation = adUseClient
rsPri.Open st, Conn, adOpenStatic, adLockReadOnly
Frame1.Visible = False
If rsPri.State <> 1 Then Exit Sub
If rsPri.RecordCount < 1 Then Exit Sub
Dim jfhj As Double
Dim dfhj As Double
Dim f As Integer
jfhj = 0
dfhj = 0
RePorts.EtCell1.OpenDoc App.Path & "\report\tz.eT"
RePorts.EtCell1.SetAliasCell "dwmc", "單位名稱：" + GetDwmc()
RePorts.EtCell1.SetAliasCell "zdrq", "新啟用月份: " & Text1 & "年" & Text2 & "月 制單日期：" + CStr(Date)
RePorts.EtCell1.SetAliasCell "bt", "本 月 新 啟 用 計(jì) 量 器 具 臺(tái) 帳"
rsPri.MoveFirst
For i = 0 To rsPri.Fields.Count - 5
If (i > 1) And (i < (rsPri.Fields.Count - 5)) Then RePorts.EtCell1.InsertCol 8
Next i
For i = 0 To rsPri.Fields.Count - 1
RePorts.EtCell1.SetCell 4, i + 2, rsPri.Fields(i).Name
Next i
i = 5
For j = 1 To rsPri.RecordCount - 1
RePorts.EtCell1.InsertRow i
Next j
rsPri.MoveFirst
Do While rsPri.EOF = False
For j = 0 To rsPri.Fields.Count - 1
RePorts.EtCell1.SetCell i, j + 2, rsPri.Fields(j)
Next j
i = i + 1
rsPri.MoveNext
Loop
RePorts.Show
Exit Sub
ERR:
MsgBox ERR.Description
End Sub
Private Sub Command2_Click()
Frame1.Visible = False
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
Text1.Text = Format(CStr(Year(Date)), "0000")
cmdll.Caption = "查 詢"
Ljl.Caption = ""
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 "設(shè)備編號(hào)"
st = "bh"
Case "設(shè)備名稱"
st = "mc"
Case "類別"
st = "lb"
Case "種別"
st = "zb"
Case "管理等級(jí)"
st = "dj"
Case "設(shè)備狀態(tài)"
st = "zt"
Case "規(guī)格型號(hào)"
st = "ggxh"
Case "測(cè)量范圍"
st = "clfw"
Case "分度值"
st = "fdz"
Case "生產(chǎn)廠家"
st = "sccj"
Case "出廠編號(hào)"
st = "ccbh"
Case "使用部門"
st = "sybm"
Case "使用者"
st = "syz"
Case "啟用日期"
st = "qyrq"
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -