📄 frm计划申请.frm
字号:
Height = 315
Index = 0
Left = 1200
TabIndex = 3
Top = 240
Width = 2055
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "备注:"
Height = 180
Index = 6
Left = 720
TabIndex = 14
Top = 2760
Width = 450
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "计量单位:"
Height = 180
Index = 5
Left = 360
TabIndex = 13
Top = 2280
Width = 810
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "物资型号:"
Height = 180
Index = 4
Left = 360
TabIndex = 12
Top = 1800
Width = 810
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "物资名称:"
Height = 180
Index = 3
Left = 360
TabIndex = 11
Top = 1320
Width = 810
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "类别编码:"
Height = 180
Index = 2
Left = 360
TabIndex = 10
Top = 840
Width = 810
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "物资编号:"
Height = 180
Index = 1
Left = 360
TabIndex = 9
Top = 360
Width = 810
End
End
Begin VB.CommandButton CmdSec
Height = 375
Left = 2520
Picture = "Frm计划申请.frx":11CC
Style = 1 'Graphical
TabIndex = 1
Top = 220
Width = 495
End
Begin VB.Label Label1
Caption = "物资基本情况"
Height = 255
Left = 1200
TabIndex = 15
Top = 320
Width = 1335
End
End
Begin MSComctlLib.ListView lstContracts
Height = 2775
Left = 120
TabIndex = 16
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 = 34
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 vsElasticLightLibCtl.vsElasticLight vsElasticLight1
Left = 0
OleObjectBlob = "Frm计划申请.frx":160E
Top = 4680
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
Private Sub CmdSec_Click()
Frm选择物资编号.Show 1
End Sub
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
Set LConRs = New ADODB.Recordset
LConRs.Open "select * from Fl_计划申请表 where 流程管理=0", 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!申请理由
LConRs.MoveNext
Loop
If Not LConRs.EOF Then LConRs.MoveFirst
lstContracts.Refresh
GetPayData
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!申请人 = Null, "0", ConPayRs!申请人)
Text5.Text = IIf(ConPayRs!申请时间 = Null, "0", ConPayRs!申请时间)
Text6.Text = IIf(ConPayRs!申请理由 = Null, "0", ConPayRs!申请理由)
WZlist ConPayRs!物资编号
End If
End Sub
Private Sub cmdDeleteExp_Click()
On Error GoTo Errline
Dim ControlDel As ADODB.Recordset
Dim ContNum As Long
Dim SqlString As String
If ConPayRs.RecordCount <> 0 Then
ConPayRs.MoveFirst
If Not ConPayRs.EOF Or ConPayRs.BOF Then
If MsgBox("确认要删除么?", vbQuestion + vbYesNo) = vbYes Then
Set ControlDel = New ADODB.Recordset
If Not lstContracts.SelectedItem.Text = Empty Then
ContNum = lstContracts.SelectedItem.Text
SqlString = "Select * from Fl_计划申请表 where 流水号=" & ContNum
ControlDel.Open SqlString, Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic, adCmdText
If ControlDel.RecordCount <> 0 Then
ControlDel.Delete
End If
DoList
End If
End If
End If
End If
Exit Sub
Errline:
MsgBox err.Source & Chr(13) & err.Description, , "错误代码:" & err.Number
End Sub
Private Sub cmdSaveExp_Click()
On Error GoTo Errline
If cmdSaveExp.Caption = "添加" Then
cmdSaveExp.Caption = "保存"
cmdUpdateExp.Enabled = False
cmdDeleteExp.Enabled = False
Command1.Enabled = True
Text2.Text = "SQ" & Year(Date) & Month(Date) & Day(Date) & Hour(Time) & Minute(Time) & Second(Time)
Text3.Text = ""
Text4.Text = Xtczy
Text5.Text = Date
Text6.Text = ""
ConPayRs.AddNew
lstContracts.Enabled = False
ElseIf cmdSaveExp.Caption = "保存" Then
If Trim(Text1(0)) = "" Or Trim(Text6) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Or Trim(Text4) = "" Or Trim(Text5) = "" Then
MsgBox "任何一栏不能为空"
Exit Sub
End If
ConPayRs!物资编号 = Text1(0).Text
ConPayRs!申请编号 = Text2.Text
ConPayRs!申请数量 = Text3.Text
ConPayRs!申请人 = Text4.Text
ConPayRs!申请时间 = Text5.Text
ConPayRs!申请理由 = Text6.Text
ConPayRs.Update
cmdSaveExp.Caption = "添加"
cmdUpdateExp.Enabled = True
cmdDeleteExp.Enabled = True
Command1.Enabled = False
lstContracts.Enabled = True
DoList
End If
Exit Sub
Errline:
MsgBox err.Source & Chr(13) & err.Description, , "错误代码:" & err.Number
End Sub
Private Sub cmdUpdateExp_Click()
On Error GoTo Errline
If Trim(Text1(0)) = "" Or Trim(Text6) = "" Or Trim(Text2) = "" Or Trim(Text3) = "" Or Trim(Text4) = "" Or Trim(Text5) = "" Then
MsgBox "任何一栏不能为空"
Exit Sub
End If
ConPayRs!物资编号 = Text1(0).Text
ConPayRs!申请编号 = Text2.Text
ConPayRs!申请数量 = Text3.Text
ConPayRs!申请人 = Text4.Text
ConPayRs!申请时间 = Text5.Text
ConPayRs!申请理由 = Text6.Text
ConPayRs.Update
DoList
Exit Sub
Errline:
MsgBox err.Source & Chr(13) & err.Description, , "错误代码:" & err.Number
End Sub
Private Sub lstContracts_Click()
GetPayData
End Sub
Private Sub Form_Load()
SecWz = 1
Set ConPayRs = New ADODB.Recordset
ConPayRs.Open "select * from Fl_计划申请表 where 流程管理=0", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic, adCmdText
DoList
End Sub
Private Sub Rlcommand_Click()
Xtcdcs = Trim(Text5.Text)
Xtfhcs = ""
XT_calendar.Show 1
If Xtfhcs <> "" Then
Text5.Text = Trim(Xtfhcs)
End If
Text5.SetFocus
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
'小数点只允许输入一次
If KeyAscii = 190 Then
If InStr(Trim(Text3), ".") = 0 Then
If Len(Trim(Text3)) > 0 Then
Text3.Locked = False
Else
Text3.Locked = True
End If
Else
Text3.Locked = True
End If
Exit Sub
End If
'非数字不能输入
If KeyAscii > 57 Or KeyAscii < 48 Then
Text3.Locked = True
Else
Text3.Locked = False
End If
'允许Backspace
If KeyAscii = 8 Then
Text3.Locked = False
End If
'Delete键
If KeyAscii = 46 Then
Text3.Locked = False
End If
End Sub
Private Sub Txt3_KeyPress(KeyAscii As Integer)
Call Lrrqxz(KeyAscii)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -