📄 frmstorage.frm
字号:
BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmStorage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public P_SID As String
Private Sub Form_Load()
'初使化下接柜
Initcbo
End Sub
Private Sub tlbOperate_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "update"
'保存数据
If P_SID = "" Then
Sava
Else
Update
End If
Case "cancel"
'撤消
InitClear
Case "first"
'首页
frmMQStorage.mintCurPage = 1
gFillFg frmMQStorage.fg, frmMQStorage.mrstDriveRoom, frmMQStorage.tlbOperate.Buttons, frmMQStorage.mintCurPage, frmMQStorage.mintPageSize
P_SID = frmMQStorage.fg.TextMatrix(1, 1)
frmMQStorage.fg.TextMatrix(0, 0) = "序号"
frmMQStorage.ShowID
If frmMQStorage.mintCurPage = 1 Then
If frmMQStorage.fg.Row = 1 Then
Me.tlbOperate.Buttons("first").Enabled = False
Me.tlbOperate.Buttons("prev").Enabled = False
Me.tlbOperate.Buttons("next").Enabled = True
Me.tlbOperate.Buttons("last").Enabled = True
End If
End If
Case "prev"
'前页
If frmMQStorage.fg.Row = frmMQStorage.fg.Rows - 1 Then
If frmMQStorage.mintCurPage <= frmMQStorage.mrstDriveRoom.PageCount Then
frmMQStorage.mintCurPage = frmMQStorage.mintCurPage - 1
gFillFg frmMQStorage.fg, frmMQStorage.mrstDriveRoom, frmMQStorage.tlbOperate.Buttons, frmMQStorage.mintCurPage, frmMQStorage.mintPageSize
P_SID = frmMQStorage.fg.TextMatrix(frmMQStorage.fg.Rows - 1, 1)
frmMQStorage.fg.TextMatrix(0, 0) = "序号"
frmMQStorage.ShowID
End If
End If
If frmMQStorage.mintCurPage = 1 Then
If frmMQStorage.fg.Row = 1 Then
Me.tlbOperate.Buttons("first").Enabled = False
Me.tlbOperate.Buttons("prev").Enabled = False
Me.tlbOperate.Buttons("next").Enabled = True
Me.tlbOperate.Buttons("last").Enabled = True
End If
End If
Case "next"
'下页
If frmMQStorage.fg.Row = frmMQStorage.fg.Rows - 1 Then
frmMQStorage.mintCurPage = frmMQStorage.mintCurPage + 1
gFillFg frmMQStorage.fg, frmMQStorage.mrstDriveRoom, frmMQStorage.tlbOperate.Buttons, frmMQStorage.mintCurPage, frmMQStorage.mintPageSize
P_SID = frmMQStorage.fg.TextMatrix(1, 1)
frmMQStorage.fg.TextMatrix(0, 0) = "序号"
frmMQStorage.ShowID
End If
If frmMQStorage.mintCurPage = frmMQStorage.mrstDriveRoom.PageCount Then
If frmMQStorage.fg.Row = frmMQStorage.fg.Rows - 1 Then
Me.tlbOperate.Buttons("first").Enabled = True
Me.tlbOperate.Buttons("prev").Enabled = True
Me.tlbOperate.Buttons("next").Enabled = False
Me.tlbOperate.Buttons("last").Enabled = False
End If
End If
Case "last"
'末页
frmMQStorage.mintCurPage = -1
gFillFg frmMQStorage.fg, frmMQStorage.mrstDriveRoom, frmMQStorage.tlbOperate.Buttons, frmMQStorage.mintCurPage, frmMQStorage.mintPageSize
P_SID = frmMQStorage.fg.TextMatrix(frmMQStorage.fg.Rows - 1, 1)
frmMQStorage.fg.TextMatrix(0, 0) = "序号"
frmMQStorage.ShowID
If frmMQStorage.mintCurPage = frmMQStorage.mrstDriveRoom.PageCount Then
If frmMQStorage.fg.Row = frmMQStorage.fg.Rows - 1 Then
Me.tlbOperate.Buttons("first").Enabled = True
Me.tlbOperate.Buttons("prev").Enabled = True
Me.tlbOperate.Buttons("next").Enabled = False
Me.tlbOperate.Buttons("last").Enabled = False
End If
End If
Case "quit"
Unload Me
End Select
End Sub
Private Sub Sava()
'保存数据
Dim sql As String
Dim Asql As String
Dim o As Integer
Dim Ars As New ADODB.Recordset
If Trim(cboAreaStorID.Text) = "" Then
MsgBox "区办信息不能为空", vbInformation, "提示"
Exit Sub
End If
If Trim(txtStorageID.Text) = "" Then
MsgBox "仓库编号不能为空", vbInformation, "提示"
Exit Sub
End If
If Trim(txtStorageName.Text) = "" Then
MsgBox "仓库名称不能为空", vbInformation, "提示"
Exit Sub
End If
'查询商品小类编号是否存在
sql = "Select StorageID from Storage Where StorageID='" & Trim(txtStorageID.Text) & "'"
Set Ars = SQLDB.Execute(sql)
If Not Ars.EOF Then
MsgBox "仓库编号已存在,不能重复添加", vbInformation, "提示"
Exit Sub
End If
'查询同一大类下面的小类名称是否已存在
sql = "Select StorageName from Storage Where StorageName='" & Trim(txtStorageName.Text) & "'"
Set Ars = SQLDB.Execute(sql)
If Not Ars.EOF Then
MsgBox "仓库名称已存在,不能重复添加", vbInformation, "提示"
Exit Sub
End If
On Error GoTo ErrShow
SQLDB.BeginTrans
'添加主表信息
Asql = "Insert into Storage(AreaStorID,StorageID,StorageName,Remark) " & _
"Values('" & Trim(cboAreaStorID.Text) & "','" & Trim(txtStorageID.Text) & "'," & _
"'" & Trim(txtStorageName.Text) & "','" & Trim(txtRemark.Text) & "')"
SQLDB.Execute Asql
SQLDB.CommitTrans
InitClear
frmMQStorage.QuerySalesRoom
MsgBox "添加成功", vbInformation, "提示"
Exit Sub
ErrShow:
SQLDB.RollbackTrans
MsgBox "添加商品小类信息出错" & Err.Description, vbInformation, "提示"
End Sub
Private Sub Update()
'修改数据
'保存数据
Dim sql As String
Dim Asql As String
Dim o As Integer
Dim Ars As New ADODB.Recordset
If Trim(cboAreaStorID.Text) = "" Then
MsgBox "区办信息不能为空", vbInformation, "提示"
Exit Sub
End If
If Trim(txtStorageName.Text) = "" Then
MsgBox "仓库名称不能为空", vbInformation, "提示"
Exit Sub
End If
'查询同一大类下面的小类名称是否已存在
sql = "Select StorageName from Storage Where AreaStorID='" & Trim(cboAreaStorID.Text) & "' " & _
"and StorageName='" & Trim(txtStorageName.Text) & "' and StorageID<>'" & Trim(txtStorageID.Text) & "'"
Set Ars = SQLDB.Execute(sql)
If Not Ars.EOF Then
MsgBox "仓库名称已存在,不能重复添加", vbInformation, "提示"
Exit Sub
End If
On Error GoTo ErrShow
SQLDB.BeginTrans
'添加主表信息
Asql = "Update Storage set AreaStorID='" & Trim(cboAreaStorID.Text) & "'," & _
"StorageName='" & Trim(txtStorageName.Text) & "',Remark='" & Trim(txtRemark.Text) & "' " & _
" Where StorageID='" & Trim(txtStorageID.Text) & "'"
SQLDB.Execute Asql
SQLDB.CommitTrans
InitClear
frmMQStorage.QuerySalesRoom
MsgBox "添加成功", vbInformation, "提示"
Exit Sub
ErrShow:
SQLDB.RollbackTrans
MsgBox "添加商品小类信息出错" & Err.Description, vbInformation, "提示"
End Sub
Private Sub InitClear()
'清空文本柜数据
txtStorageID.Text = ""
txtStorageName.Text = ""
txtRemark.Text = ""
End Sub
Private Sub Initcbo()
'初使化大类
Dim sql As String
Dim Ars As New ADODB.Recordset
sql = "Select distinct AreaStorID from AreaStor"
Set Ars = SQLDB.Execute(sql)
Do While Not Ars.EOF
cboAreaStorID.AddItem Ars("AreaStorID")
Ars.MoveNext
cboAreaStorID.ListIndex = 0
Loop
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -