📄 frmzhczp.frm
字号:
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 120
TabIndex = 16
Top = 2640
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 = 13
Top = 1800
Width = 735
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 = 12
Top = 1080
Width = 1095
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 = 11
Top = 1080
Width = 1095
End
Begin VB.Label Label2
BackColor = &H80000000&
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 375
Left = 4560
TabIndex = 10
Top = 360
Width = 2655
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 = 5
Top = 360
Width = 1335
End
Begin VB.Label Label4
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 = 4
Top = 120
Width = 975
End
End
Attribute VB_Name = "frmzhczp"
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_zhczpzb 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) = "" Then
A = MsgBox("操作单位或操作任务为空，请填写该项目！", vbOKOnly)
Exit Sub
Else
Set RS = ZHCX.Execute(sql1, 0)
Label2.Caption = Format(Now, "yyyy-mm") + "-" + Format(RS(0) + 1, "000")
If RS.State Then
RS.Close
End If
sql2 = "select max(id) from xdgl_zhczpzb"
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_zhczpzb (id,zlph,rq,czdw,czrw,npyj,npjtxm,zxrq) values (" & ID & ",'" & Trim(Label2.Caption) & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Trim(Combo2.Text) & "','" & Trim(Text4.Text) & "','" & Trim(Combo1.Text) & "','" & Trim(Text1.Text) & "','" & Format(DTPicker2.Value, "yyyy-mm-dd") & "')"
Debug.Print sql3
Set RS = ZHCX.Execute(sql3, 0)
Command1.Enabled = False
Adodc1.RecordSource = "select * from xdgl_zhczpfb where zlph='" & Trim(Label2.Caption) & "'"
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(Label2.Caption) = "" Then
A = MsgBox("请先生成综合操作票号！", vbOKOnly)
Exit Sub
End If
sql1 = "select max(id) from xdgl_zhczpfb"
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_zhczpfb where zlph='" & Trim(Label2.Caption) & "'"
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(Label2.Caption)
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_zhczpzb set bz='" & Trim(Text2.Text) & "' where zlph='" & Trim(Label2.Caption) & "'"
'sql2 = "select bz from xdgl_zhczpzb where zlph='" & Trim(Label2.Caption) & "'"
If Trim(Text2.Text) = "" Then
Else
'Set RS = ZHCX.Execute(sql2, 0)
'If Not IsNull(RS(0)) Then
Set RS = ZHCX.Execute(sql1, 0)
' If RS1.State Then
' RS1.Close
' End If
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 ActiveReport3
ActiveReport3.Show
Call Open_link
Sql = "select * from xdgl_zhczpzb where zlph='" & Trim(Label2.Caption) & "'"
Set RS = ZHCX.Execute(Sql, 0)
If RS.EOF Then
ActiveReport3.Label12 = Format(DTPicker2.Value, "yyyy年mm月dd日")
ActiveReport3.Label4 = ""
ActiveReport3.Label5 = ""
ActiveReport3.Label9 = ""
ActiveReport3.Label17 = ""
ActiveReport3.Label19 = ""
ActiveReport3.Field4.Text = ""
Else
ActiveReport3.Label12 = Format(RS("ZXRQ"), "yyyy年mm月dd日")
ActiveReport3.Label62 = CStr(Trim(Format(RS("RQ"), "yyyy-MM-dd ")))
ActiveReport3.Label4 = Trim(RS("npyj"))
ActiveReport3.Label5 = Trim(RS("npjtxm"))
ActiveReport3.Label9 = Trim(Label2.Caption)
ActiveReport3.Label17 = Trim(RS("czdw"))
ActiveReport3.Label19 = Trim(RS("czrw"))
ActiveReport3.Field4.Text = Trim(RS("bz"))
End If
If RS.State Then
RS.Close
End If
Sql = "select * from xdgl_zhczpfb where zlph='" & Trim(Label2.Caption) & "'"
Set RS = ZHCX.Execute(Sql, 0)
If Not RS.EOF Then
ActiveReport3.Label53.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Err Then Err.Clear
If Not RS.EOF Then
ActiveReport3.Label54.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport3.Label55.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport3.Label56.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport3.Label57.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport3.Label58.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport3.Label59.Caption = Trim(CStr(RS("jlxh"))) + " . " + Trim(CStr(RS("zysx")))
RS.MoveNext
If Not RS.EOF Then
ActiveReport3.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
ActiveReport3.PageSetup
End Sub
Private Sub Command5_Click()
On Error Resume Next
If Label2.Caption = "" Then
Exit Sub
End If
sql1 = "update xdgl_zhczpzb set czrw='" & Trim(Text4.Text) & "',czdw='" & Trim(Combo2.Text) & "',npyj='" & Trim(Combo1.Text) & "',npjtxm='" & Trim(Text1.Text) & "',bz='" & Trim(Text2.Text) & "' where zlph='" & Trim(Label2.Caption) & "'"
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 hh:mm")
DTPicker2.Value = Format(Now, "yyyy-mm-dd")
Adodc1.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx "
Adodc1.RecordSource = "select * from xdgl_zhczpfb where zlph='" & Trim(Label2.Caption) & "'"
Adodc1.Refresh
Call Open_link
sql2 = "select sbmc from xdgl_sblx where sblx='厂站' or 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 + -