📄 frmproductionembryocontractmain.frm
字号:
Top = 480
Width = 480
End
Begin VB.Label Label11
BackColor = &H80000005&
Caption = "業務員"
Height = 255
Left = 1020
TabIndex = 27
Top = 660
Width = 1035
End
Begin VB.Label Label3
BackColor = &H80000005&
Caption = "布名"
Height = 255
Index = 1
Left = 1020
TabIndex = 26
Top = 1080
Width = 1035
End
Begin VB.Label Label3
BackColor = &H80000005&
Caption = "合同編號"
Height = 255
Index = 4
Left = 1020
TabIndex = 25
Top = 240
Width = 1035
End
Begin VB.Label Label1
BackColor = &H80000005&
Caption = "訂胚日期"
Height = 315
Left = 1020
TabIndex = 24
Top = 2040
Width = 915
End
Begin VB.Label Label2
BackColor = &H80000005&
Caption = "進坯日期"
Height = 255
Left = 1020
TabIndex = 23
Top = 3060
Width = 975
End
Begin VB.Label Label4
BackColor = &H80000005&
Caption = "坯交日期"
Height = 315
Left = 1020
TabIndex = 22
Top = 2520
Width = 915
End
Begin VB.Label Label5
BackColor = &H80000005&
Caption = "供應商"
Height = 315
Left = 5580
TabIndex = 21
Top = 240
Width = 915
End
Begin VB.Label Label6
BackColor = &H80000005&
Caption = "業務聯絡人"
Height = 315
Left = 5580
TabIndex = 20
Top = 660
Width = 915
End
Begin VB.Label Label7
BackColor = &H80000005&
Caption = "布號"
Height = 375
Left = 5580
TabIndex = 19
Top = 1080
Width = 915
End
Begin VB.Label Label10
BackColor = &H80000005&
Caption = "胚組織"
Height = 255
Left = 5580
TabIndex = 18
Top = 1560
Width = 1035
End
Begin VB.Label Label13
BackColor = &H80000005&
Caption = "至"
Height = 255
Left = 5640
TabIndex = 17
Top = 2640
Width = 255
End
Begin VB.Label Label14
BackColor = &H80000005&
Caption = "至"
Height = 255
Left = 5640
TabIndex = 16
Top = 3120
Width = 255
End
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHF1
Height = 8115
Left = 120
TabIndex = 2
Top = 240
Width = 14775
_ExtentX = 26061
_ExtentY = 14314
_Version = 393216
AllowUserResizing= 1
_NumberOfBands = 1
_Band(0).Cols = 2
End
End
End
End
Attribute VB_Name = "frmProductionEmbryoContractMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim lngrow As Long
Private Sub ActiveBar21_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
Select Case Tool.Name
Case "cmdAdd":
frmProductionEmbryoContractInfo.newItem = True
frmProductionEmbryoContractInfo.Show vbModal
Case "cmdDel":
DelOperatorInf
Case "cmdCancel":
Unload Me
Case "cmdEdit":
EditOperatorInf
Case "cmdIn"
frmProductionEmbryoIn.InitInfo MSHF1.TextMatrix(lngrow, 3)
frmProductionEmbryoIn.Show vbModal
Case "cmdOut"
frmProductionEmbryoOut.InitInfo MSHF1.TextMatrix(lngrow, 3)
frmProductionEmbryoOut.Show vbModal
Case "cmdFind"
fraFind.Visible = True
Case "cmdRefurbish":
FillMshf1 ("select * from tProductionEmbryoContract")
Case "cmdPrint"
Call PrintEmbryoContract
Case "cmdExport":
Dim strFile As String
frmMain.CDFile.ShowOpen
strFile = frmMain.CDFile.FileName
If strFile = "" Then Exit Sub
ExportExcel MSHF1, strFile
End Select
End Sub
Private Sub PrintEmbryoContract()
If lngrow = 1 Then
MsgBox "請選擇合約!", vbInformation + vbOKOnly, "提示"
Exit Sub
End If
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim rsobj As ADODB.Recordset
Set rsobj = New ADODB.Recordset
Dim strSql As String
With rs
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
Set .ActiveConnection = Cn
End With
strSql = "select * from tProductionEmbryoContract where id=" & MSHF1.TextMatrix(lngrow, 24) & "and FabricCode='" & MSHF1.TextMatrix(lngrow, 7) & "'"
rs.Open strSql
With BillEmbryoContract
.EmbryoContractNo.SetText (rs.Fields!EmbryoContractNo)
.Founddate.SetText (rs.Fields!Founddate)
.SuppliersName.SetText (rs.Fields!SuppliersName)
.Linkman.SetText (rs.Fields!Linkman)
.Operation.SetText (rs.Fields!Operation)
.FabricName.SetText (rs.Fields!FabricName)
.Composition.SetText (rs.Fields!Greige)
.fWidth.SetText (rs.Fields!Width)
.FabricCode.SetText (rs.Fields!FabricCode)
.Price.SetText (rs.Fields!Price)
.Delivery.SetText (rs.Fields!Delivery)
.Amount.SetText (rs.Fields!Amount)
End With
With rsobj
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
End With
rsobj.Fields.Append "Remarks", adBSTR
rsobj.Open
rsobj.AddNew
rsobj.Fields!Remarks = rs.Fields!Remark
rsobj.Update
BillEmbryoContract.dataBase.SetDataSource rsobj
rs.Close
rsobj.Close
Set rsobj = Nothing
Set rs = Nothing
frmReportEmbryoContract.Show vbModal
End Sub
Private Function FormatQuery() As String
FormatQuery = "select * from tProductionEmbryoContract"
If Trim$(txtEmbryoContractNo.Text) = "" Then
FormatQuery = FormatQuery & " where EmbryoContractNo<>''"
Else
FormatQuery = FormatQuery & " where EmbryoContractNo='" & txtEmbryoContractNo & "'"
End If
If Trim$(txtFabricCode) <> "" Then
FormatQuery = FormatQuery & " and FabricCode='" & txtFabricCode & "'"
End If
If chkdelivery.Value = vbChecked Then
FormatQuery = FormatQuery & " and Delivery >= '" & FormatDateStr(Delivery.Value, "long") & "'"
FormatQuery = FormatQuery & " and Delivery <= '" & FormatDateStr(EndDelivery.Value, "long") & "'"
End If
If chkFoundDate.Value = vbChecked Then
FormatQuery = FormatQuery & " and FoundDate >= '" & FormatDateStr(Founddate.Value, "long") & "'"
FormatQuery = FormatQuery & " and FoundDate <= '" & FormatDateStr(EndFounddate.Value, "long") & "'"
End If
If chkCurrentDate.Value = vbChecked Then
FormatQuery = FormatQuery & " and CurrentDate >= '" & FormatDateStr(CurrentDate.Value, "long") & "'"
FormatQuery = FormatQuery & " and CurrentDate <= '" & FormatDateStr(EndCurrentDate.Value, "long") & "'"
End If
If Trim$(txtSuppliersName) <> "" Then
FormatQuery = FormatQuery & " and SuppliersName" & objDatabase.FormatLikeSQL(txtSuppliersName)
End If
If Trim$(txtOperation) <> "" Then
FormatQuery = FormatQuery & " and Operation" & objDatabase.FormatLikeSQL(txtOperation)
End If
If Trim$(txtLinkman) <> "" Then
FormatQuery = FormatQuery & " and Linkman" & objDatabase.FormatLikeSQL(txtLinkman)
End If
If Trim$(txtFabricName) <> "" Then
FormatQuery = FormatQuery & " and FabricName" & objDatabase.FormatLikeSQL(txtFabricName)
End If
If Trim$(txtFactoryName) <> "" Then
FormatQuery = FormatQuery & " and FactoryName" & objDatabase.FormatLikeSQL(txtFactoryName)
End If
If Trim$(txtGreige) <> "" Then
FormatQuery = FormatQuery & " and Greige" & objDatabase.FormatLikeSQL(txtGreige)
End If
End Function
Private Sub cmdCancel_Click()
fraFind.Visible = False
End Sub
Private Sub CmdFabric_Click()
frmFabricSelect.Show vbModal
GetFabricInfo frmFabricSelect.FabricCode
End Sub
Private Sub GetFabricInfo(FabricNo As String)
Dim rs As ADODB.Recordset
On Error GoTo errLabel
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -