📄 frmbeforereference.frm
字号:
VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "Actbar2.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmBeforeReference
Caption = "用途資料"
ClientHeight = 3645
ClientLeft = 60
ClientTop = 345
ClientWidth = 7560
LinkTopic = "Form1"
ScaleHeight = 3645
ScaleWidth = 7560
StartUpPosition = 3 'Windows Default
Begin ActiveBar2LibraryCtl.ActiveBar2 ActiveBar21
Height = 3645
Left = 0
TabIndex = 0
Top = 0
Width = 7560
_LayoutVersion = 1
_ExtentX = 13335
_ExtentY = 6429
_DataPath = ""
Bands = "frmBeforeReference.frx":0000
Begin VB.Frame Frame1
Height = 3015
Left = 60
TabIndex = 1
Top = 540
Width = 7395
Begin VB.TextBox Washing
Height = 330
Left = 1500
MaxLength = 50
TabIndex = 8
Top = 1980
Width = 1995
End
Begin VB.TextBox Placement
BackColor = &H00FFFFFF&
Height = 315
Left = 1500
MaxLength = 50
TabIndex = 7
Top = 1560
Width = 1995
End
Begin VB.TextBox Reference
BackColor = &H8000000F&
Enabled = 0 'False
Height = 315
Left = 1500
MaxLength = 20
TabIndex = 6
Top = 1140
Width = 1995
End
Begin VB.TextBox RefLabdipNo
BackColor = &H8000000F&
Enabled = 0 'False
Height = 315
Left = 1500
MaxLength = 20
TabIndex = 5
Top = 240
Width = 1995
End
Begin VB.TextBox RefOrderNo
BackColor = &H8000000F&
Enabled = 0 'False
Height = 315
Left = 1500
MaxLength = 20
TabIndex = 4
Top = 660
Width = 1995
End
Begin VB.TextBox RefUpdateOperator
Height = 315
Left = 1500
MaxLength = 20
TabIndex = 3
Top = 2460
Width = 1995
End
Begin VB.TextBox refId
Height = 270
Left = 4440
TabIndex = 2
Top = 840
Visible = 0 'False
Width = 555
End
Begin MSComCtl2.DTPicker RefUpdateDate
Height = 315
Left = 5160
TabIndex = 9
Top = 2460
Width = 2055
_ExtentX = 3625
_ExtentY = 556
_Version = 393216
Format = 92798977
CurrentDate = 39583
End
Begin VB.Label Label27
Caption = "洗水"
Height = 255
Left = 360
TabIndex = 16
Top = 1980
Width = 1275
End
Begin VB.Label Label28
Caption = "填入日期"
Height = 255
Left = 4020
TabIndex = 15
Top = 2520
Width = 1035
End
Begin VB.Label Label29
Caption = "填寫人"
Height = 255
Left = 360
TabIndex = 14
Top = 2460
Width = 1035
End
Begin VB.Label Label30
Caption = "上批單號"
Height = 255
Left = 360
TabIndex = 13
Top = 300
Width = 1035
End
Begin VB.Label Label2
Caption = "訂單號"
Height = 255
Index = 2
Left = 420
TabIndex = 12
Top = 720
Width = 1035
End
Begin VB.Label Label3
Caption = "成衣款號"
Height = 255
Index = 8
Left = 360
TabIndex = 11
Top = 1140
Width = 1035
End
Begin VB.Label Label3
Caption = "用途"
Height = 255
Index = 9
Left = 360
TabIndex = 10
Top = 1560
Width = 1035
End
End
End
End
Attribute VB_Name = "frmBeforeReference"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public newItem As Boolean 'true表示增加
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
Select Case Tool.Name
Case "cmdSave":
Save newItem
Case "cmdCancel":
Unload Me
Case "cmdDel":
DelOperatorInf
End Select
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
InitTitle
End Sub
Private Sub InitTitle()
Label30.Caption = "上批單號"
Label2.item(2).Caption = "訂單號"
Label3.item(8).Caption = "成衣款號"
Label3.item(9).Caption = "用途"
Label27.Caption = "洗水"
Label29.Caption = "填寫人"
Label28.Caption = "填入日期"
Me.Caption = "用途資料"
End Sub
Private Sub DelOperatorInf()
Dim strSql As String
On Error GoTo errHandle
If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
Exit Sub
Else
strSql = "delete from tBeforeLabdipReference where LabdipNo='" & RefLabdipNo & "' and Reference='" & Reference & "'"
objDatabase.ExecCmd strSql
MsgBox "刪除成功!", vbInformation, "提示"
End If
frmBeforeInfo.FillMshf5 ("select * from tBeforeLabdipReference where LabdipNo='" & RefLabdipNo & "'")
Unload Me
Exit Sub
errHandle:
objDatabase.DatabaseError
End Sub
Public Sub InitInfo(strId As String, LabdipNo As String, OrderNo As String, txtReference As String)
If newItem = False Then
Dim rs As ADODB.Recordset
SystemExecuteStart Me
' On Error GoTo errLabel
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
Set .ActiveConnection = Cn
End With
Dim strSql As String
strSql = "select * from tBeforeLabdipReference where id=" & strId
rs.Open strSql
If Not rs.EOF Then
RefLabdipNo.Text = NullValue(rs.Fields!LabdipNo)
RefOrderNo.Text = NullValue(rs.Fields!OrderNo)
Reference.Text = NullValue(rs.Fields!Reference)
Placement = NullValue(rs.Fields!Placement)
Washing = NullValue(rs.Fields!Washing)
RefUpdateOperator = NullValue(rs.Fields!UpdateOperator)
RefUpdateDate = NullValue(rs.Fields!UpdateDate)
refId = NullValue(rs.Fields!ID)
End If
rs.Close
Set rs = Nothing
SystemExecuteEnd Me
Exit Sub
Else
RefLabdipNo.Text = LabdipNo
RefOrderNo.Text = OrderNo
Reference.Text = txtReference
SystemExecuteEnd Me
Exit Sub
End If
errLabel:
SystemExecuteEnd Me
objDatabase.DatabaseError
End Sub
Private Sub Save(Optional blModi As Boolean)
Dim strSql As String
Dim rs As ADODB.Recordset
Dim mycomm As ADODB.Command
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
Set .ActiveConnection = Cn
End With
On Error GoTo errHandle
If blModi Then
strSql = "select * from tBeforeLabdipReference"
rs.Open strSql
If RefLabdipNo = "" Or RefOrderNo = "" Or Reference = "" Then
MsgBox "請將信息填寫完整 ", vbCritical, " 提示"
rs.Close
Set rs = Nothing
Reference.SetFocus
Exit Sub
End If
If MsgBox("是否增加？", vbQuestion + vbYesNo, "询问") = vbNo Then
rs.Close
Set rs = Nothing
Exit Sub
End If
rs.AddNew '新建
Else
strSql = "select * from tBeforeLabdipReference where id=" & refId
rs.Open strSql
If rs.EOF Then '修改
MsgBox "没有可修改的信息!", vbExclamation, "修改"
rs.Close
Set rs = Nothing
Reference.SetFocus
Exit Sub
End If
If MsgBox("是否修改记录？", vbYesNo + vbQuestion, "修改") = vbNo Then
rs.Close
Set rs = Nothing
Exit Sub
End If
End If
rs.Fields!LabdipNo = Trim$(RefLabdipNo)
rs.Fields!OrderNo = Trim$(RefOrderNo)
rs.Fields!Reference = Trim$(Reference)
rs.Fields!Placement = Trim$(Placement)
rs.Fields!Washing = Washing
rs.Fields!UpdateOperator = RefUpdateOperator
rs.Fields!UpdateDate = Now
rs.Update
MsgBox "操作成功！", vbInformation, "恭喜"
rs.Close
Set rs = Nothing
frmBeforeInfo.FillMshf5 ("select * from tBeforeLabdipReference where LabdipNo='" & RefLabdipNo & "'")
Unload Me
Exit Sub
errHandle:
Set rs = Nothing
objDatabase.DatabaseError
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -