📄 frmoutput.frm
字号:
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "资料已变更，未保存"
Height = 180
Left = 6600
TabIndex = 23
Top = 4560
Visible = 0 'False
Width = 1620
End
Begin VB.Image Image1
Height = 240
Left = 6240
Picture = "frmOutput.frx":11F2
Top = 4560
Visible = 0 'False
Width = 240
End
Begin VB.Label lblCaption
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label1"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 0
Left = 240
TabIndex = 19
Top = 240
Width = 570
End
End
Begin VB.TextBox txtID
Height = 270
Left = 4320
TabIndex = 20
Top = 1320
Visible = 0 'False
Width = 975
End
Begin VB.ComboBox Combo4
Height = 300
Left = 4560
TabIndex = 21
Text = "Combo4"
Top = 1800
Width = 1215
End
Begin VB.ComboBox Combo5
Height = 300
Left = 4320
TabIndex = 22
Text = "Combo5"
Top = 3000
Width = 1215
End
Begin vkUserContolsXP.vkCommand cmdPage
Height = 375
Index = 2
Left = 12000
TabIndex = 16
Top = 4920
Width = 1095
_ExtentX = 1931
_ExtentY = 661
BackColorPushed1= 16514043
BackColorPushed2= 14474460
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin vkUserContolsXP.vkCommand cmdPage
Height = 375
Index = 4
Left = 14040
TabIndex = 18
Top = 4920
Width = 975
_ExtentX = 1720
_ExtentY = 661
BackColorPushed1= 16514043
BackColorPushed2= 14474460
Caption = "尾 页"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "frmOutput.frx":157C
End
Begin vkUserContolsXP.vkCommand cmdPage
Height = 375
Index = 3
Left = 13080
TabIndex = 17
Top = 4920
Width = 975
_ExtentX = 1720
_ExtentY = 661
BackColorPushed1= 16514043
BackColorPushed2= 14474460
Caption = "下一页"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "frmOutput.frx":1916
End
Begin vkUserContolsXP.vkCommand cmdPage
Height = 375
Index = 1
Left = 11040
TabIndex = 15
Top = 4920
Width = 975
_ExtentX = 1720
_ExtentY = 661
BackColorPushed1= 16514043
BackColorPushed2= 14474460
Caption = "上一页"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "frmOutput.frx":1CB0
End
Begin vkUserContolsXP.vkCommand cmdPage
Height = 375
Index = 0
Left = 10080
TabIndex = 14
Top = 4920
Width = 975
_ExtentX = 1720
_ExtentY = 661
BackColorPushed1= 16514043
BackColorPushed2= 14474460
Caption = "首页"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Picture = "frmOutput.frx":204A
End
End
Attribute VB_Name = "frmOutput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim TotalCol As Long
Dim lngOldQty As Long
Dim strCaption() As String
Dim bEditMode As Boolean
Dim CurPage As Long
Sub ShowFlag(bVisible As Boolean)
Image1.Visible = bVisible
Label1.Visible = bVisible
End Sub
Function CheckWHQty(StrQty As String) As Boolean
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim RSTemp As New ADODB.Recordset
Dim strSQL As String
Dim strMin As String, strMax As String, strCur As String
Dim Total As Long
ConnTemp.Open StrConn
strSQL = "select * from WHQty where WHID=" & Combo4.Text & " AND GoodsID=" & Combo5.Text
RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
If RSTemp.RecordCount > 0 Then
strCur = RSTemp("Qty").Value
Else
strCur = "0"
End If
RSTemp.Close
strSQL = "select * from WHSetting where WHID=" & Combo4.Text & " AND GoodsID=" & Combo5.Text & " order by ID DESC"
RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
If RSTemp.RecordCount > 0 Then
strMin = RSTemp("MinValue").Value
strMax = RSTemp("MaxValue").Value
Total = Val(strCur) - Val(StrQty)
If strMin <> "" Then
If Val(strMin) > Total Then
MsgBox "出库后的库存量为[" & Total & "], 小于预设的库存最小值[" & strMin & "]", vbOKOnly + vbInformation
End If
End If
If strMax <> "" Then
If Val(strMax) < Total Then
MsgBox "出库后的库存量为[" & Total & "], 大于预设的库存最大值[" & strMax & "]", vbOKOnly + vbInformation
End If
End If
RSTemp.Close
Set RSTemp = Nothing
Else
'物品的最大、最小值未区分仓库
RSTemp.Close
strSQL = "select * from WHSetting where WHID=-1 AND GoodsID=" & Combo5.Text & " order by ID DESC"
RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
If RSTemp.RecordCount > 0 Then
strMin = RSTemp("MinValue").Value
strMax = RSTemp("MaxValue").Value
Total = Val(strCur) - Val(StrQty)
If strMin <> "" Then
If Val(strMin) > Total Then
MsgBox "出库后的库存量为[" & Total & "], 小于预设的库存最小值[" & strMin & "]", vbOKOnly + vbInformation
End If
End If
If strMax <> "" Then
If Val(strMax) < Total Then
MsgBox "出库后的库存量为[" & Total & "], 大于预设的库存最大值[" & strMax & "]", vbOKOnly + vbInformation
End If
End If
RSTemp.Close
Set RSTemp = Nothing
End If
End If
CheckWHQty = False
ConnTemp.Close
Set ConnTemp = Nothing
Exit Function
ErrFlag:
If RSTemp.State = adStateOpen Then RSTemp.Close
Set RSTemp = Nothing
If ConnTemp.State = adStateOpen Then ConnTemp.Close
Set ConnTemp = Nothing
MsgBox "[检查库存]" & Err.Description, vbCritical
End Function
Sub InitGrid()
On Error Resume Next
Dim i As Long
DataShow.Cols = UBound(strCaption) + 2
With DataShow
.Redraw = False
.Clear
For i = 0 To UBound(strCaption) + 1
.TextMatrix(0, i + 1) = strCaption(i)
.ColWidth(i + 1) = 2000
.ColAlignment(i) = 1
Next
.ColWidth(2) = 1300
.ColWidth(6) = 1200
.ColWidth(0) = 0
.Redraw = True
End With
End Sub
Sub UpdateShow()
On Error GoTo ErrFlag
Dim ConnTemp As New ADODB.Connection
Dim RSTemp As New ADODB.Recordset
Dim strSQL As String
Dim i As Long, j As Long
Call InitGrid
strSQL = "SELECT OutData.AutoID, OutData.ID, OutData.InDate, WH.WHName, goods.ID, goods.GoodsName, OutData.Qty,OutData.OPName, OutData.memo "
strSQL = strSQL & "FROM (OutData LEFT JOIN goods ON OutData.GoodsID = goods.AutoID) LEFT JOIN WH ON OutData.WHID = WH.ID order by OutData.AutoID DESC"
ConnTemp.Open StrConn
RSTemp.Open strSQL, ConnTemp, adOpenStatic, adLockReadOnly
If RSTemp.RecordCount > 0 Then
With DataShow
.Redraw = False
.Rows = MaxPageSize + 1
RSTemp.PageSize = MaxPageSize
If CurPage <= 0 Then CurPage = 1
If CurPage > RSTemp.PageCount Then CurPage = RSTemp.PageCount
cmdPage(2).Caption = CurPage & "/" & RSTemp.PageCount & " 页"
RSTemp.Move MaxPageSize * (CurPage - 1)
For i = 1 To MaxPageSize
.Row = i
For j = 0 To RSTemp.Fields.Count - 1
.Col = j
If IsNull(RSTemp.Fields(j).Value) = False Then
.Text = RSTemp.Fields(j).Value
End If
Next j
RSTemp.MoveNext
If RSTemp.EOF Then
.Rows = i + 1
Exit For
End If
Next i
.Redraw = True
End With
Else
cmdPage(2).Caption = "0/0 页"
End If
RSTemp.Close
ConnTemp.Close
Set RSTemp = Nothing
Set ConnTemp = Nothing
Exit Sub
ErrFlag:
DataShow.Redraw = True
If RSTemp.State = adStateOpen Then RSTemp.Close
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -