📄 frm转地调综合操作票.frm
字号:
Caption = "拟票时间"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 8400
TabIndex = 24
Top = 120
Width = 975
End
Begin VB.Label Label5
Caption = "票 号"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 3600
TabIndex = 23
Top = 360
Width = 1335
End
Begin VB.Label Label3
Caption = "操作单位"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 120
TabIndex = 22
Top = 1080
Width = 1095
End
Begin VB.Label Label7
Caption = "操作任务"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 3600
TabIndex = 21
Top = 1080
Width = 1095
End
Begin VB.Label Label9
Caption = "备注："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 480
TabIndex = 20
Top = 1800
Width = 735
End
Begin VB.Label Label10
Caption = "注意事项"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 120
TabIndex = 19
Top = 2640
Width = 1095
End
Begin VB.Label Label6
Caption = "执行时间"
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 8400
TabIndex = 18
Top = 600
Width = 975
End
End
Attribute VB_Name = "frm转地调综合操作票"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sql1 As String
Dim RS As ADODB.Recordset
Dim sql2 As String
Dim sql3 As String
Dim jlxh As String
Private Sub command1_Click()
On Error Resume Next
sql1 = "select count(zlph) from xdgl_zzhczpzb where rq between '" & Format(Now, "yyyy-mm-01") & "' and '" & DateAdd("d", -1, DateAdd("m", 1, Format(Now, "yyyy-mm-01"))) & "'"
Call Open_link
If Trim(Combo2.Text) = "" Or Trim(Text4.Text) = "" Or Trim(Text3.Text = "") Then
A = MsgBox("操作单位或操作任务、票号为空，请填写该项目！", vbOKOnly)
Exit Sub
Else
sql2 = "select max(id) from xdgl_zzhczpzb"
Set RS = ZHCX.Execute(sql2, 0)
If Not IsNull(RS(0)) Then
ID = RS(0) + 1
Else
ID = 1
End If
If RS.State Then
RS.Close
End If
sql3 = "insert xdgl_zzhczpzb (id,zlph,rq,czdw,czrw,npyj,npjtxm) values (" & ID & ",'" & Trim(Text3.Text) & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Trim(Combo2.Text) & "','" & Trim(Text4.Text) & "','" & Trim(Combo1.Text) & "','" & Trim(Text1.Text) & "')"
Debug.Print sql3
Set RS = ZHCX.Execute(sql3, 0)
Command1.Enabled = False
Adodc1.RecordSource = "select * from xdgl_zzhczpfb where zlph='" & Trim(Text3.Text) & "'"
Adodc1.Refresh
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveLast
End If
Call sx
End If
Call Close_link
End Sub
Private Sub Command2_Click()
On Error Resume Next
If Trim(Text3.Text) = "" Then
A = MsgBox("请先生成综合操作票号！", vbOKOnly)
Exit Sub
End If
sql1 = "select max(id) from xdgl_zzhczpfb"
Call Open_link
Set RS = ZHCX.Execute(sql1, 0)
If Not IsNull(RS(0)) Then
ID = RS(0) + 1
Else
ID = 1
End If
If RS.State Then
RS.Close
End If
sql2 = "select max(jlxh) from xdgl_zzhczpfb where zlph='" & Trim(Text3.Text) & "'"
Set RS = ZHCX.Execute(sql2, 0)
If Not IsNull(RS(0)) Then
jlxh = RS(0) + 1
Else
jlxh = 1
End If
If RS.State Then
RS.Close
End If
Adodc1.Recordset.AddNew
DataGrid1.Columns(0).Value = ID
DataGrid1.Columns(1).Value = jlxh
DataGrid1.Columns(2).Value = Trim(Text3.Text)
DataGrid1.Columns(3).Value = Trim(Text5.Text)
Adodc1.Recordset.Update
Adodc1.Refresh
DataGrid1.Refresh
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveLast
End If
sql1 = "update xdgl_zzhczpzb set bz='" & Trim(Text2.Text) & "' where zlph='" & Trim(Text3.Text) & "'"
If Trim(Text2.Text) = "" Then
Else
Set RS = ZHCX.Execute(sql1, 0)
End If
If RS1.State Then
RS1.Close
End If
Call sx
Text5.Text = ""
Call Close_link
End Sub
Private Sub Command3_Click()
On Error Resume Next
If Adodc1.Recordset.EOF Then
A = MsgBox("不能删除空记录", vbDefaultButton2)
Exit Sub
End If
A = MsgBox("是否确认删除该记录", vbYesNo)
If A = 6 Then
Adodc1.Recordset.Delete
Else
Exit Sub
End If
Adodc1.Recordset.Update
Adodc1.Refresh
DataGrid1.Refresh
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.MoveLast
End If
Call sx
Combo1.Clear
End Sub
Private Sub Command4_Click()
On Error Resume Next
Unload ActiveReport5
ActiveReport5.Show
Call Open_link
Sql = "select * from xdgl_zzhczpzb where zlph='" & Trim(Text3.Text) & "'"
Set RS = ZHCX.Execute(Sql, 0)
If RS.EOF Then
ActiveReport5.Label12 = Format(DTPicker1.Value, "yyyy年mm月dd日")
ActiveReport5.Label4 = ""
ActiveReport5.Label5 = ""
ActiveReport5.Label9 = ""
ActiveReport5.Label17 = ""
ActiveReport5.Label19 = ""
ActiveReport5.Field4.Text = ""
Else
ActiveReport5.Label12 = Format(RS("rq"), "yyyy年mm月dd日")
ActiveReport5.Label62 = Format(RS("rq"), "yyyy-mm-dd ")
ActiveReport5.Label4 = Trim(RS("npyj"))
ActiveReport5.Label5 = Trim(RS("npjtxm"))
ActiveReport5.Label9 = Trim(Text3.Text)
ActiveReport5.Label17 = Trim(RS("czdw"))
ActiveReport5.Label19 = Trim(RS("czrw"))
ActiveReport5.Field4.Text = Trim(RS("bz"))
End If
If RS.State Then
RS.Close
End If
Sql = "select * from xdgl_zzhczpfb where zlph='" & Trim(Text3.Text) & "'"
Set RS = ZHCX.Execute(Sql, 0)
If Not RS.EOF Then
ActiveReport5.Label53.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Err Then Err.Clear
If Not RS.EOF Then
ActiveReport5.Label54.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport5.Label55.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport5.Label56.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport5.Label57.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport5.Label58.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport5.Label59.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport5.Label60.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
End If
End If
End If
End If
End If
End If
End If
End If
If RS.State Then
RS.Close
End If
Call Close_link
ActiveReport5.PageSetup
End Sub
Private Sub Command5_Click()
On Error Resume Next
If Text3.Text = "" Then
Exit Sub
End If
sql1 = "update xdgl_zzhczpzb set czrw='" & Trim(Text4.Text) & "',czdw='" & Trim(Combo2.Text) & "',npyj='" & Trim(Combo1.Text) & "',npjtxm='" & Trim(Text1.Text) & "',bz='" & Trim(Text2.Text) & "' where zlph='" & Trim(Text3.Text) & "'"
Call Open_link
Set RS = ZHCX.Execute(sql1, 0)
Call Close_link
A = MsgBox("操作票修改成功", vbOKOnly)
End Sub
Private Sub DataGrid1_LostFocus()
If Adodc1.Recordset.EOF Then
Else
Adodc1.Recordset.Update
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
DTPicker1.Value = Format(Now, "yyyy-mm-dd")
Adodc1.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx "
Adodc1.RecordSource = "select * from xdgl_zzhczpfb where zlph='" & Trim(Text3.Text) & "'"
Adodc1.Refresh
Call Open_link
sql2 = "select sbmc from xdgl_sblx where sblx='厂站'"
Combo2.Clear
Set RS = ZHCX.Execute(sql2, 0)
Do While Not RS.EOF
If Not IsNull(RS(0)) Then
Combo2.AddItem Trim(RS(0))
End If
RS.MoveNext
Loop
If RS.State Then
RS.Close
End If
Call Close_link
Combo1.AddItem "计划检修"
Combo1.AddItem "临时检修"
Combo1.AddItem "事故处理"
Combo1.AddItem "状态转换"
Combo1.Text = ""
Text1.Text = ""
Text2.Text = ""
'‘Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Call sx
Call qk
End Sub
Sub sx()
DataGrid1.Columns(0).Visible = False
DataGrid1.Columns(1).Caption = "序号"
DataGrid1.Columns(3).Caption = "注意事项"
DataGrid1.Columns(3).Width = 10000
DataGrid1.Columns(2).Visible = False
End Sub
Sub qk()
'Text1.Text = ""
Text2.Text = ""
'Text3.Text = ""
'Text4.Text = ""
Text5.Text = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -