📄 frmbeforelayout.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 frmBeforeLayout
Caption = "花型明細"
ClientHeight = 4275
ClientLeft = 60
ClientTop = 345
ClientWidth = 7530
LinkTopic = "Form1"
ScaleHeight = 4275
ScaleWidth = 7530
StartUpPosition = 3 'Windows Default
Begin ActiveBar2LibraryCtl.ActiveBar2 ActiveBar21
Height = 4275
Left = 0
TabIndex = 0
Top = 0
Width = 7530
_LayoutVersion = 1
_ExtentX = 13282
_ExtentY = 7541
_DataPath = ""
Bands = "frmBeforeLayout.frx":0000
Begin VB.Frame Frame1
Height = 3675
Left = 60
TabIndex = 1
Top = 540
Width = 7395
Begin VB.ComboBox subLayoutFactoryName
Height = 300
Left = 1380
TabIndex = 22
Text = "Combo1"
Top = 2340
Width = 1995
End
Begin VB.CheckBox subLayout
Caption = "Check1"
Height = 255
Left = 1380
TabIndex = 21
Top = 1500
Width = 255
End
Begin VB.TextBox subLayoutLabdipNo
BackColor = &H8000000F&
Enabled = 0 'False
Height = 315
Left = 1380
MaxLength = 20
TabIndex = 8
Top = 240
Width = 1995
End
Begin VB.TextBox subLayoutName
Height = 330
Left = 1380
MaxLength = 50
TabIndex = 7
Top = 1020
Width = 1995
End
Begin VB.TextBox subLayoutOrderNo
BackColor = &H8000000F&
Enabled = 0 'False
Height = 315
Left = 1380
MaxLength = 20
TabIndex = 6
Top = 660
Width = 1995
End
Begin VB.TextBox subLayoutUpdateDate
BackColor = &H8000000F&
Enabled = 0 'False
Height = 315
Left = 5160
TabIndex = 5
Top = 3180
Width = 1995
End
Begin VB.TextBox LayoutReviews
Height = 315
Left = 1380
MaxLength = 20
TabIndex = 4
Top = 1860
Width = 1995
End
Begin VB.TextBox subLayoutUpdateoperator
Height = 315
Left = 5160
MaxLength = 20
TabIndex = 3
Top = 2760
Width = 1995
End
Begin VB.TextBox subLayoutId
Height = 270
Left = 2640
TabIndex = 2
Top = 1440
Visible = 0 'False
Width = 735
End
Begin MSComCtl2.DTPicker subLayoutLabdipDate
Height = 315
Left = 1380
TabIndex = 9
Top = 2760
Width = 1995
_ExtentX = 3519
_ExtentY = 556
_Version = 393216
Format = 92798977
CurrentDate = 39583
End
Begin MSComCtl2.DTPicker subLayoutReviewsDate
Height = 315
Left = 1380
TabIndex = 10
Top = 3180
Width = 1995
_ExtentX = 3519
_ExtentY = 556
_Version = 393216
Format = 92798977
CurrentDate = 39583
End
Begin VB.Label Label12
Caption = "上批單號"
Height = 315
Left = 240
TabIndex = 20
Top = 300
Width = 795
End
Begin VB.Label Label17
Caption = "填入日期"
Height = 315
Left = 3900
TabIndex = 19
Top = 3240
Width = 915
End
Begin VB.Label Label3
Caption = "花型結果"
Height = 255
Index = 6
Left = 240
TabIndex = 18
Top = 1560
Width = 1035
End
Begin VB.Label Label18
Caption = "評語日期"
Height = 255
Left = 240
TabIndex = 17
Top = 3240
Width = 1035
End
Begin VB.Label Label3
Caption = "花型名稱"
Height = 255
Index = 7
Left = 240
TabIndex = 16
Top = 1140
Width = 1035
End
Begin VB.Label Label19
Caption = "訂單號"
Height = 255
Left = 240
TabIndex = 15
Top = 720
Width = 1035
End
Begin VB.Label Label20
Caption = "評語"
Height = 255
Left = 240
TabIndex = 14
Top = 1980
Width = 1035
End
Begin VB.Label Label21
Caption = "加工廠"
Height = 255
Left = 240
TabIndex = 13
Top = 2400
Width = 1035
End
Begin VB.Label Label25
Caption = "上批日期"
Height = 255
Left = 240
TabIndex = 12
Top = 2820
Width = 1035
End
Begin VB.Label Label26
Caption = "填寫人"
Height = 255
Left = 3900
TabIndex = 11
Top = 2760
Width = 1035
End
End
End
End
Attribute VB_Name = "frmBeforeLayout"
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
Initcbb subLayoutFactoryName, "FactoryName", "tBasicFactory"
InitTitle
End Sub
Private Sub InitTitle()
Label12.Caption = "上批單號"
Label19.Caption = "訂單號"
Label3.item(7).Caption = "花型名稱"
Label3.item(6).Caption = "花型結果"
Label20.Caption = "評語"
Label21.Caption = "加工廠"
Label25.Caption = "上批日期"
Label26.Caption = "填寫人"
Label18.Caption = "評語日期"
Label17.Caption = "填入日期"
Me.Caption = "花型明細"
End Sub
Private Sub DelOperatorInf()
Dim strSql As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
On Error GoTo errHandle
If MsgBox("确定要刪除？", vbQuestion + vbYesNo, "询问") = vbNo Then
Exit Sub
Else
strSql = "delete from tBeforeLabdipLayoutSub where LabdipNo='" & subLayoutLabdipNo & "'and LayoutName='" & subLayoutName & "'"
objDatabase.ExecCmd strSql
MsgBox "刪除成功!", vbInformation, "提示"
End If
rs.Open "select Layout from tBeforeLabdipLayoutSub where Layout=0 and LabdipNo='" & subLayoutLabdipNo & "'", Cn, 1, 3
If rs.BOF Or rs.EOF Then
frmBeforeInfo.chkColor.Value = 1
Else
frmBeforeInfo.chkColor.Value = 0
End If
rs.Close
Set rs = Nothing
frmBeforeInfo.FillMshf6 ("select * from tBeforeLabdipLayoutSub where LabdipNo='" & subLayoutLabdipNo & "'")
Unload Me
Exit Sub
errHandle:
objDatabase.DatabaseError
End Sub
Public Sub InitInfo(strId As String, LabdipNo As String, OrderNo 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 tBeforeLabdipLayoutSub where id=" & strId
rs.Open strSql
If Not rs.EOF Then
subLayoutLabdipNo.Text = NullValue(rs.Fields!LabdipNo)
subLayoutOrderNo.Text = NullValue(rs.Fields!OrderNo)
subLayoutId = NullValue(rs.Fields!ID)
subLayoutName.Text = NullValue(rs.Fields!LayoutName)
subLayout = IIf(rs.Fields!Layout, "1", "0")
LayoutReviews = NullValue(rs.Fields!Reviews)
subLayoutFactoryName = NullValue(rs.Fields!FactoryName)
subLayoutLabdipDate = NullValue(rs.Fields!LabdipDate)
subLayoutReviewsDate = NullValue(rs.Fields!ReviewsDate)
subLayoutUpdateoperator = NullValue(rs.Fields!UpdateOperator)
subLayoutUpdateDate = NullValue(rs.Fields!UpdateDate)
End If
rs.Close
Set rs = Nothing
SystemExecuteEnd Me
Exit Sub
Else
subLayoutLabdipNo.Text = LabdipNo
subLayoutOrderNo.Text = OrderNo
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 strCdh, strZl, strSl 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 tBeforeLabdipLayoutSub"
rs.Open strSql
If subLayoutLabdipNo = "" Or subLayoutOrderNo = "" Or subLayoutName = "" Then
MsgBox "請將信息填寫完整 ", vbCritical, " 提示"
rs.Close
Set rs = Nothing
subLayoutLabdipNo.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 tBeforeLabdipLayoutSub where id=" & subLayoutId
rs.Open strSql
If rs.EOF Then '修改
MsgBox "没有可修改的信息!", vbExclamation, "修改"
rs.Close
Set rs = Nothing
subLayoutLabdipNo.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$(subLayoutLabdipNo)
rs.Fields!OrderNo = Trim$(subLayoutOrderNo)
rs.Fields!LayoutName = Trim$(subLayoutName)
rs.Fields!Layout = subLayout.Value
rs.Fields!Reviews = Trim$(LayoutReviews)
rs.Fields!FactoryName = Trim$(subLayoutFactoryName)
rs.Fields!LabdipDate = subLayoutLabdipDate.Value
rs.Fields!ReviewsDate = subLayoutReviewsDate.Value
rs.Fields!UpdateOperator = subLayoutUpdateoperator
rs.Fields!UpdateDate = Now
rs.Update
MsgBox "操作成功！", vbInformation, "恭喜"
rs.Close
rs.Open ("select Layout from tBeforeLabdipLayoutSub where Layout = 0 and LabdipNo='" & subLayoutLabdipNo & "'")
If rs.EOF Or rs.BOF Then
frmBeforeInfo.chkType.Value = 1
Else
frmBeforeInfo.chkType.Value = 0
End If
rs.Close
Set rs = Nothing
frmBeforeInfo.FillMshf6 ("select * from tBeforeLabdipLayoutSub where LabdipNo='" & subLayoutLabdipNo & "'")
Unload Me
Exit Sub
errHandle:
Set rs = Nothing
objDatabase.DatabaseError
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -