📄 frm计划审核.frm
字号:
TabIndex = 0
Top = 480
Width = 2895
End
Begin MSComctlLib.ListView lstContracts
Height = 2775
Left = 120
TabIndex = 3
Top = 4320
Width = 9975
_ExtentX = 17595
_ExtentY = 4895
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin MovingChar.MovingText MovingText1
Height = 375
Left = 0
TabIndex = 32
Top = 0
Width = 10215
_ExtentX = 18018
_ExtentY = 661
MsgChar = "欢迎您选用《宇迪资源管理系统》 作者：倪德根 13301481112 2008.3"
CharColor = 65535
BackColor = 16744576
FontSize = 9.75
MousePointer = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "申请理由"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 360
TabIndex = 30
Top = 3720
Width = 960
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "申请人"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 600
TabIndex = 29
Top = 3240
Width = 720
End
Begin vsElasticLightLibCtl.vsElasticLight vsElasticLight1
Left = 0
OleObjectBlob = "Frm计划审核.frx":1FF2
Top = 1560
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "申请数量"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 360
TabIndex = 25
Top = 1080
Width = 960
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "审核理由"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 360
TabIndex = 24
Top = 2520
Width = 960
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "审核人"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 600
TabIndex = 23
Top = 1560
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "审核结果"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 360
TabIndex = 22
Top = 2040
Width = 960
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "申请编号"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 360
TabIndex = 1
Top = 555
Width = 960
End
End
Attribute VB_Name = "Frm计划审核"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rstmp As ADODB.Recordset
Dim TxtSqlbj As String
Dim LConRs As ADODB.Recordset
Dim ConPayRs As ADODB.Recordset
Dim TxtSql As String
Public Sub WZlist(TxtBHStr As String)
TxtSqlbj = "select * from Fl_物资信息表 where 物资编号= '" & TxtBHStr & "'"
Set Rstmp = New ADODB.Recordset
Rstmp.Open TxtSqlbj, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
If Rstmp.BOF And Rstmp.EOF Then
Text1(1).Text = ""
Text1(2).Text = ""
Text1(3).Text = ""
Text1(4).Text = ""
Text1(5).Text = ""
Text1(6).Text = ""
MovingText1.MsgChar = "欢迎您选用《宇迪资源管理系统》 作者：倪德根 13301481112 2008.4"
MsgBox "没有此物资可用信息！"
Else
Text1(0).Text = Rstmp!物资编号
Text1(1).Text = Rstmp!类别编码
Text1(2).Text = Rstmp!物资名称
Text1(3).Text = Rstmp!物资型号
Text1(4).Text = Rstmp!计量单位
Text1(5).Text = " " & Rstmp!备注信息
MovingText1.MsgChar = "物资：" & Rstmp!物资名称 & " 现库存数量为： "
End If
Rstmp.Close
Set Rstmp = Nothing
End Sub
Private Sub DoList()
Dim ItmX As ListItem
lstContracts.ColumnHeaders.Clear
lstContracts.ColumnHeaders.Add , , "流水号", Len("流水号") * 100 + 550
lstContracts.ColumnHeaders.Add , , "申请编号", Len("申请编号") * 100 + 550 * 2
lstContracts.ColumnHeaders.Add , , "物资编号", Len("物资编号") * 100 + 550
lstContracts.ColumnHeaders.Add , , "申请数量", Len("申请数量") * 100 + 550
lstContracts.ColumnHeaders.Add , , "申请人", Len("申请人") * 100 + 500
lstContracts.ColumnHeaders.Add , , "申请时间", Len("申请时间") * 100 + 950
lstContracts.ColumnHeaders.Add , , "流程管理", Len("流程管理") * 250
lstContracts.ColumnHeaders.Add , , "申请理由", Len("申请理由") * 250 + 550 * 3
lstContracts.ColumnHeaders.Add , , "审核人", Len("审核人") * 250
lstContracts.ColumnHeaders.Add , , "审核理由", Len("审核理由") * 250 + 550 * 3
Set LConRs = New ADODB.Recordset
LConRs.Open "SELECT * FROM Fl_计划申请表 where 流程管理<2", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic
If Not LConRs.BOF Then LConRs.MoveFirst
lstContracts.ListItems.Clear
Do While Not LConRs.EOF
Set ItmX = lstContracts.ListItems.Add(, , LConRs!流水号)
ItmX.SubItems(1) = LConRs!申请编号
ItmX.SubItems(2) = LConRs!物资编号
ItmX.SubItems(3) = LConRs!申请数量
ItmX.SubItems(4) = LConRs!申请人
ItmX.SubItems(5) = LConRs!申请时间
If LConRs!流程管理 = "0" Then
ItmX.SubItems(6) = "№"
ElseIf LConRs!流程管理 = "1" Then
ItmX.SubItems(6) = "㊣"
ElseIf LConRs!流程管理 = "2" Then
ItmX.SubItems(6) = "X"
ElseIf LConRs!流程管理 = "3" Then
ItmX.SubItems(6) = "√"
End If
ItmX.SubItems(7) = LConRs!申请理由
ItmX.SubItems(8) = "" & LConRs!审核人
ItmX.SubItems(9) = "" & LConRs!审核理由
LConRs.MoveNext
Loop
If Not LConRs.EOF Then LConRs.MoveFirst
lstContracts.Refresh
End Sub
Private Sub GetPayData()
Dim SqlString As Long
If Not lstContracts.ListItems.Count < 1 Then
SqlString = Trim(lstContracts.SelectedItem.Text)
Set ConPayRs = New ADODB.Recordset
ConPayRs.Open "Select * from Fl_计划申请表 where 流水号=" & SqlString, Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic, adCmdText
Text2.Text = IIf(ConPayRs!申请编号 = Null, " ", ConPayRs!申请编号)
' Txt3.Text = IIf(ConPayRs!物资编号 = Null, " ", ConPayRs!物资编号)
Text3.Text = IIf(ConPayRs!申请数量 = Null, " ", ConPayRs!申请数量)
Text4.Text = IIf(ConPayRs!审核人 = "暂空", Xtczy, ConPayRs!审核人)
Text5.Text = IIf(ConPayRs!审核理由 = "暂空", "未审核", ConPayRs!审核理由)
Text6.Text = IIf(ConPayRs!申请理由 = Null, " ", ConPayRs!申请理由)
Text7.Text = IIf(ConPayRs!申请人 = Null, " ", ConPayRs!申请人)
If ConPayRs!流程管理 = "0" Then
Check1.Value = 0
Else
Check1.Value = 1
End If
WZlist ConPayRs!物资编号
End If
End Sub
Private Sub CmdSc_Click()
If Trim(Text2.Text) = "" Then Exit Sub
Set ConPayRs = New ADODB.Recordset
ConPayRs.Open "Select * from Fl_计划申请表 where 申请编号='" & Trim(Text2.Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic, adCmdText
If ConPayRs.BOF And ConPayRs.EOF Then Exit Sub
Text2.Text = IIf(ConPayRs!申请编号 = Null, " ", ConPayRs!申请编号)
' Txt3.Text = IIf(ConPayRs!物资编号 = Null, " ", ConPayRs!物资编号)
Text3.Text = IIf(ConPayRs!申请数量 = Null, " ", ConPayRs!申请数量)
Text4.Text = IIf(ConPayRs!审核人 = "暂空", Xtczy, ConPayRs!审核人)
Text5.Text = IIf(ConPayRs!审核理由 = "暂空", "未审核", ConPayRs!审核理由)
Text6.Text = IIf(ConPayRs!申请理由 = Null, " ", ConPayRs!申请理由)
Text7.Text = IIf(ConPayRs!申请人 = Null, "", ConPayRs!申请人)
If ConPayRs!流程管理 = "0" Then
Check1.Value = 0
Else
Check1.Value = 1
End If
WZlist ConPayRs!物资编号
End Sub
Private Sub CmdUpdata_Click()
On Error GoTo Errline
If Trim(Text2.Text) = "" Then
MsgBox "申请编号不能为空！"
Exit Sub
End If
If Trim(Text5.Text) = "" Then
MsgBox "申请理由不能为空！"
Exit Sub
Else
If MsgBox("确认要修改申请状态么？ 申请编号：" & Trim(Text2.Text), vbQuestion + vbYesNo) = vbYes Then
Dim CmdExe As ADODB.Command
Set CmdExe = New ADODB.Command
CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
CmdExe.CommandText = "update Fl_计划申请表 set 申请编号='" & Trim(Text2.Text) & "',审核理由='" & Text5.Text & " ',审核人='" & Text4.Text & "',流程管理= '" & Check1.Value & "' where 申请编号='" & Text2.Text & "'"
CmdExe.Execute
DoList
End If
End If
Exit Sub
Errline:
MsgBox err.Description, vbCritical
End Sub
Private Sub Form_Load()
Dim ConPayRs As ADODB.Recordset
SecWz = 1
Set ConPayRs = New ADODB.Recordset
ConPayRs.Open "Select * from Fl_计划申请表 where 流程管理<2", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic, adCmdText
DoList
End Sub
Private Sub lstContracts_Click()
GetPayData
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -