📄 出库管理窗口.frm
字号:
Left = 6120
TabIndex = 28
Top = 960
Width = 735
End
Begin VB.Label Label1
Caption = "字母或汉字"
ForeColor = &H00FF0000&
Height = 375
Index = 5
Left = 6120
TabIndex = 27
Top = 960
Width = 615
End
Begin VB.Label Label1
Caption = "字母或汉字"
ForeColor = &H00FF0000&
Height = 375
Index = 6
Left = 9480
TabIndex = 26
Top = 960
Width = 615
End
Begin VB.Label Label1
Caption = "数字"
ForeColor = &H00FF0000&
Height = 375
Index = 7
Left = 2640
TabIndex = 25
Top = 1560
Width = 735
End
Begin VB.Label Label1
Caption = "数字"
ForeColor = &H00FF0000&
Height = 375
Index = 8
Left = 6120
TabIndex = 24
Top = 1560
Width = 735
End
Begin VB.Label Label1
Caption = "数字"
ForeColor = &H00FF0000&
Height = 375
Index = 9
Left = 9480
TabIndex = 23
Top = 1560
Width = 615
End
Begin VB.Label Label1
Caption = "汉字或字母"
ForeColor = &H00FF0000&
Height = 375
Index = 10
Left = 6120
TabIndex = 22
Top = 2160
Width = 615
End
Begin VB.Label Label1
Caption = "格式如""2007-7-1"""
ForeColor = &H00FF0000&
Height = 375
Index = 11
Left = 2640
TabIndex = 21
Top = 2160
Width = 975
End
Begin VB.Label Label1
Caption = "汉字或字母"
ForeColor = &H00FF0000&
Height = 375
Index = 12
Left = 9480
TabIndex = 20
Top = 2160
Width = 615
End
Begin VB.Label Label1
Caption = "汉字或字母"
ForeColor = &H00FF0000&
Height = 375
Index = 13
Left = 7920
TabIndex = 19
Top = 2760
Width = 615
End
End
Begin VB.Frame Frame2
Caption = "出库信息列表框"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3975
Left = 0
TabIndex = 0
Top = 4080
Width = 10455
Begin MSFlexGridLib.MSFlexGrid msglist
Height = 3615
Left = 120
TabIndex = 1
Top = 240
Width = 10215
_ExtentX = 18018
_ExtentY = 6376
_Version = 393216
End
End
End
Attribute VB_Name = "ckgl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public a As String
Public b As String
Private Sub Command1_Click()
Dim intCount As Integer
Dim sMsg As String
Dim MsgText As String
Dim AddMsg As Boolean
AddMsg = True
For intCount = 0 To 12
If Trim$(Text1(intCount).Text) = "" Then
sMsg = Replace(Label2(intCount).Caption, " ", "")
sMsg = sMsg & "不能为空"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
Text1(intCount).SetFocus
AddMsg = False
Exit For
Exit Sub
End If
Next
Dim rs As ADODB.Recordset
txtSQL = "select * from muse where ckno='" & Trim$(Text1(0).Text) & "'and ckid='" & Trim$(Text1(1).Text) & "'"
Set rs = ExecuteSQL(txtSQL, txtmsg)
If rs.EOF = False Then
sMsg = "已经存在此物资编号和出库编号的记录,请重新输入物资编号或入库编号!"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
Text1(0).Text = ""
Text1(1).Text = ""
Text1(0).SetFocus
AddMsg = False
Exit Sub
End If
rs.Close
If AddMsg = True Then
txtSQL = "select * from muse"
Set rs = ExecuteSQL(txtSQL, txtmsg)
rs.AddNew
For intCount = 0 To 12
rs(intCount) = Text1(intCount)
Next
rs.Update
rs.Close
sMsg = "添加记录成功!是否继续添加记录 "
If MsgBox(sMsg, vbOKCancel + vbExclamation, "提示") = vbOK Then
For intCount = 0 To 12
Text1(intCount).Text = ""
Next
ckgl.ShowData
End If
End If
Set rs = Nothing
End Sub
Private Sub Form_Load()
ShowTitle
ShowData
End Sub
Private Sub ShowTitle()
Dim i As Integer
With msglist
.Cols = 14
.TextMatrix(0, 1) = "出库编号"
.TextMatrix(0, 2) = "物资编号"
.TextMatrix(0, 3) = "物资名称"
.TextMatrix(0, 4) = "规格型号"
.TextMatrix(0, 5) = "类别"
.TextMatrix(0, 6) = "计量单位"
.TextMatrix(0, 7) = "数量"
.TextMatrix(0, 8) = "单价"
.TextMatrix(0, 9) = "金额"
.TextMatrix(0, 10) = "入库日期"
.TextMatrix(0, 11) = "领货人"
.TextMatrix(0, 12) = "经办人"
.TextMatrix(0, 13) = "备注"
.FixedRows = 1
For i = 0 To 12
.ColAlignment(i) = 0
Next i
.FillStyle = flexFillRepeat
.Col = 0
.RowSel = 1
.ColSel = .Cols - 1
.CellAlignment = 4
.ColWidth(0) = 200
.ColWidth(1) = 1000
.ColWidth(2) = 1000
.ColWidth(3) = 1000
.ColWidth(4) = 1000
.ColWidth(5) = 1000
.ColWidth(6) = 1000
.ColWidth(7) = 1000
.ColWidth(8) = 1000
.ColWidth(9) = 1000
.ColWidth(10) = 1000
.ColWidth(11) = 1000
.ColWidth(12) = 1000
.ColWidth(12) = 1000
.Row = 1
End With
End Sub
Public Sub ShowData()
Dim j As Integer
Dim i As Integer
Dim rs As ADODB.Recordset
If txtSQL = "" Then
txtSQL = "select * from muse"
End If
Set rs = ExecuteSQL(txtSQL, txtmsg)
If rs.EOF = False Then
rs.MoveFirst
With msglist
.Rows = 1
Do While Not rs.EOF
.Rows = .Rows + 1
For i = 1 To rs.Fields.Count - 1
Select Case rs.Fields(i).Type
Case adDBDate
.TextMatrix(.Rows - 1, i) = Format(rs.Fields(i - 1), "yyyy-m-d")
Case Else
.TextMatrix(.Rows - 1, i) = rs.Fields(i - 1)
End Select
Next i
.TextMatrix(.Rows - 1, i) = rs.Fields(i - 1)
rs.MoveNext
Loop
End With
End If
rs.Close
End Sub
Private Sub Msglist_Click()
For i = 0 To 12
Text1(i) = msglist.TextMatrix(msglist.RowSel, i + 1)
Next i
a = Format(Text1(0), "0000")
b = Format(Text1(1), "0000")
End Sub
Private Sub Command2_Click()
Dim intCount As Integer
Dim sMsg As String
Dim MsgText As String
Dim AddMsg As Boolean
AddMsg = True
For intCount = 0 To 12
If Trim$(Text1(intCount).Text) = "" Then
sMsg = Replace(Label2(intCount).Caption, " ", "")
sMsg = sMsg & "不能为空"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
Text1(intCount).SetFocus
AddMsg = False
Exit For
Exit Sub
End If
Next
Dim rs As ADODB.Recordset
If MsgBox("保存当前记录的变化吗 ", vbOKCancel + vbExclamation, "提示") = vbOK Then
AddMsg = True
Else
AddMsg = False
End If
If AddMsg = True Then
txtSQL = "select * from muse where ckno='" & Trim$(a) & "'and ckid='" & Trim$(b) & "'"
Set rs = ExecuteSQL(txtSQL, txtmsg)
For intCount = 0 To 12
rs(intCount) = Text1(intCount)
Next
rs.Update
rs.Close
a = Format(Text1(0), "0000")
b = Format(Text1(1), "0000")
sMsg = "修改记录成功!"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
ckgl.ShowData
End If
Set rs = Nothing
End Sub
Private Sub Command3_Click()
Dim intCount As Integer
Dim sMsg As String
Dim AddMsg As Boolean
Dim rs As ADODB.Recordset
If MsgBox("删除当前记录吗 ", vbOKCancel + vbExclamation, "提示") = vbOK Then
AddMsg = True
Else
AddMsg = False
End If
If AddMsg = True Then
txtSQL = "delete * from muse where ckno='" & Trim(Text1(0).Text) & "'and ckid='" & Trim$(Text1(1).Text) & "'"
Set rs = ExecuteSQL(txtSQL, txtmsg)
sMsg = "删除记录成功!"
MsgBox sMsg, vbOKOnly + vbExclamation, "警告"
ckgl.ShowData
End If
Set rs = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -