📄 frmtakeoutedit.frm
字号:
BackStyle = 0 'Transparent
Caption = "警告期(天)"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 8760
TabIndex = 32
Top = 960
Width = 1290
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "有效期(天)"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 5640
TabIndex = 31
Top = 960
Width = 1290
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数量上限"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 3000
TabIndex = 30
Top = 960
Width = 1020
End
Begin VB.Label Label18
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数量下限"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 240
TabIndex = 29
Top = 960
Width = 1020
End
Begin VB.Label LblProLow
Height = 255
Left = 1440
TabIndex = 28
Top = 960
Width = 1455
End
Begin VB.Label LblProHigh
Height = 255
Left = 4080
TabIndex = 27
Top = 960
Width = 1455
End
Begin VB.Label LblValid
Height = 255
Left = 6960
TabIndex = 26
Top = 960
Width = 1455
End
Begin VB.Label LblAlarmDays
Height = 255
Left = 10080
TabIndex = 25
Top = 960
Width = 1455
End
Begin VB.Label Label2
Caption = "选择的产品是："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3720
TabIndex = 3
Top = 480
Width = 1695
End
End
Begin VB.Label LblOK
BackStyle = 0 'Transparent
Caption = "确 定"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4560
MouseIcon = "FrmTakeoutEdit.frx":0CCA
MousePointer = 99 'Custom
TabIndex = 20
Top = 6720
Width = 735
End
Begin VB.Image Image3
Height = 300
Left = 3960
Picture = "FrmTakeoutEdit.frx":0FD4
Top = 6720
Width = 300
End
Begin VB.Label LblCancel
BackStyle = 0 'Transparent
Caption = "取 消"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6960
MouseIcon = "FrmTakeoutEdit.frx":13F0
MousePointer = 99 'Custom
TabIndex = 19
Top = 6720
Width = 855
End
Begin VB.Image Image4
Height = 300
Left = 6360
Picture = "FrmTakeoutEdit.frx":16FA
Top = 6720
Width = 300
End
End
Attribute VB_Name = "FrmTakeoutEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public OriTakeoutType As String
Public OK As Integer
Private Sub CmbLocation_Click()
Adodc2.ConnectionString = "driver={SQL Server};server=" + Trim(Server) + ";uid=" + Trim(User) + ";pwd=" + Trim(Password) + ";database=ERP"
Adodc2.RecordSource = "select * from StoreRoom where StoreRoom='" + Trim(CmbStoreRoom.Text) + "' and Location='" + Trim(CmbLocation.Text) + "'"
Adodc2.Refresh
Set LblDescription.DataSource = Adodc2
If Adodc2.Recordset.RecordCount <> 0 Then
LblDescription.Caption = Adodc2.Recordset.Fields(3)
End If
End Sub
Private Sub CmbStoreRoom_Click()
If CmbLocation.Text <> "请选择库号" Then
CmbLocation.Enabled = True
CmbLocation.Clear
'装入CmbLocation的信息
CmbLocation.AddItem "请选择位号"
MyStoreIn.Load_Location (CmbStoreRoom.Text)
i = 0
Do While Arr_Item(i) <> ""
CmbLocation.AddItem Arr_Item(i)
i = i + 1
Loop
CmbLocation.ListIndex = 0
End If
End Sub
Private Sub DataGrid1_Click()
If Adodc1.Recordset.RecordCount <> 0 Then
TxItem.Text = Adodc1.Recordset.Fields(1)
Frame4.Enabled = True
Set LblQty.DataSource = Adodc1
LblQty.DataField = "Qty"
Set LblStoreRoom.DataSource = Adodc1
LblStoreRoom.DataField = "StoreRoom"
Set LblLocation.DataSource = Adodc1
LblLocation.DataField = "Location"
LblProLow.Caption = Adodc1.Recordset.Fields("ProLow")
LblProHigh = Adodc1.Recordset.Fields("ProHigh")
LblValid = Adodc1.Recordset.Fields("Valid")
LblAlarmDays = Adodc1.Recordset.Fields("AlarmDays")
LblOK.Enabled = True
End If
End Sub
Private Sub Form_Load()
Adodc1.ConnectionString = "driver={SQL Server};server=" + Trim(Server) + ";uid=" + Trim(User) + ";pwd=" + Trim(Password) + ";database=ERP"
If OriTakeoutType = "销售出库" Or OriTakeoutType = "退货出库" Then
Adodc1.RecordSource = "select * from Item,Store where Item.Item=Store.Item and Item.MB<>'B购买' and Item.MB<>'S外发' "
Else
Adodc1.RecordSource = "select * from Item,Store where Item.Item=Store.Item and Item.MB<>'M制造' "
End If
Set DataGrid1.DataSource = Adodc1
'LblOK.Enabled = False
OK = 1
End Sub
Private Sub LblCancel_Click()
Unload Me
End Sub
Private Function Check() As Boolean
If Trim(TxtTakeoutID) = "" Then
MsgBox "请输入出库ID"
TxtTakeoutID.SetFocus
Check = False
Exit Function
End If
If Trim(TxtUnitPrice) = "" Then
MsgBox "请输入产品出价"
TxtUnitPrice.SetFocus
Check = False
Exit Function
End If
If Trim(TxtCurrency1) = "" Then
MsgBox "请输入货币类型"
TxtCurrency1.SetFocus
Check = False
Exit Function
End If
If Trim(TxtQty) = "" Then
MsgBox "请输入出库数量"
TxtQty.SetFocus
Check = False
Exit Function
Else
If TxtQty.Text > LblQty.Caption Then
MsgBox "出库数量大于库存数量，请重新输入"
TxtQty.SetFocus
Check = False
Exit Function
End If
End If
If Trim(TxtFillinPerson.Text) = "" Then
MsgBox "请输入经办人姓名"
TxtFillinPerson.SetFocus
Check = False
Exit Function
End If
Check = True
End Function
Private Sub LblOK_Click()
'判断要编辑信息是否完整
If Check = False Then
Exit Sub
End If
With MyTakeOut
.TakeOutID = TxtTakeoutID.Text
.TakeOutType = LblTakeoutType.Caption
.Item = TxItem.Text
.UnitPrice = TxtUnitPrice.Text
.Currency1 = TxtCurrency1.Text
.Qty = TxtQty.Text
.StoreRoom = LblStoreRoom.Caption
.Location = LblLocation.Caption
.FillinPerson = TxtFillinPerson.Text
.FillinTime = LblFillinTime.Caption
If .In_DB(TxtTakeoutID.Text) = True Then
MsgBox "出库ID重复，请重新设置"
TxtTakeoutID.SetFocus
TxtTakeoutID.SelStart = 0
TxtTakeoutID.SelLength = Len(TxtTakeoutID)
Exit Sub
Else
If OK = 1 Then
MsgBox "确认后出库单将不能修改，请再检查一遍"
OK = 2
Exit Sub
Else
If Trim(TxtQty.Text) < Trim(LblQty.Caption) Then
.UpdateStore TxItem.Text, TxtQty.Text, LblStoreRoom.Caption, LblLocation.Caption '更新库存表中的数量
End If
If Trim(TxtQty.Text) = Trim(LblQty.Caption) Then
.OutStore TxItem.Text, LblStoreRoom.Caption, LblLocation.Caption '从库存表中删除此货号，全部出库
End If
If Trim(TxtQty.Text) > Trim(LblQty.Caption) Then
MsgBox "出货量大于库存量，请重新填写"
TxtQty.SetFocus
Exit Sub
End If
.Insert '添加进出库单
MsgBox "出库成功"
End If
End If
End With
Unload Me
End Sub
Private Sub TxtQty_KeyPress(KeyAscii As Integer)
EnterTAB (KeyAscii)
If In_Single(KeyAscii) = False Then
KeyAscii = 0
End If
End Sub
Private Sub TxtUnitPrice_KeyPress(KeyAscii As Integer)
EnterTAB (KeyAscii)
If In_Single(KeyAscii) = False Then
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -