?? dlg_outbill.frm
字號:
rsTmp.Close
Dim strMsg As String
' 檢驗出庫凈重、件數、毛重是否超出庫存 colArray 中的值分別為物料ID、物料編號、凈重、件數、毛重的列號。
strMsg = checkOutWeight(Me.msfgTtl, Array(10, 1, 6, 8, 9), billId)
If strMsg <> "" Then
MsgBox strMsg, vbCritical, "數據無效"
Exit Sub
End If
strMsg = ""
Dim deleted As Boolean
deleted = False
Dim productCode As String
For i = mf1.FixedRows To mf1.rows - mf1.FixedRows
productCode = Mid(mf1.TextMatrix(i, 1), g_barcode_product_start, g_barcode_weight_start - g_barcode_product_start - g_barcode_sequenceno_len)
If mf1.TextMatrix(i, 13) <> "" And mf1.TextMatrix(i, 6) <> "" Then
If isAdd = False And deleted = False Then
Dim sql As String
sql = " delete from hpos_StockOutBill_Dtl where billId=" + Chr(34) + txtBillId.Text + Chr(34)
g_db.Execute sql
sql = " delete from hpos_StockOutBill_Master where billId=" + Chr(34) + txtBillId.Text + Chr(34)
g_db.Execute sql
deleted = True
End If
hasDtl = True
rs1.AddNew
If billNo.Text <> "" Then rs1.Fields("billId") = billId
rs1.Fields("dtlId") = billId & "_" & i
' 產品ID
If mf1.TextMatrix(i, 13) <> "" Then rs1.Fields("productId") = mf1.TextMatrix(i, 13)
' 條形碼
If mf1.TextMatrix(i, 1) <> "" Then rs1.Fields("barcode") = mf1.TextMatrix(i, 1)
If mf1.TextMatrix(i, 6) <> "" Then rs1.Fields("qty") = mf1.TextMatrix(i, 6)
If mf1.TextMatrix(i, 7) <> "" Then rs1.Fields("price") = mf1.TextMatrix(i, 7)
If mf1.TextMatrix(i, 9) <> "" Then rs1.Fields("axesWeight") = mf1.TextMatrix(i, 9)
If mf1.TextMatrix(i, 10) <> "" Then rs1.Fields("pieceQty") = mf1.TextMatrix(i, 10)
If mf1.TextMatrix(i, 12) <> "" Then rs1.Fields("comment") = mf1.TextMatrix(i, 12)
' 如果不是第一個客戶的版本就要保存編號
If (g_CustomerSN > 1) Then
' 用于打印的編號，刪除中間某行之后該編號不變，就是新增時的序號，便于在入庫單管理模塊中打印；當在出入庫管理模塊中刪除中間某行之后，部分編號與序號就不一致了。
rs1.Fields("rsvFld1") = Me.mf1.TextMatrix(i, 0)
End If
rs1.Update '更新表
ElseIf mf1.TextMatrix(i, 1) <> "" And mf1.TextMatrix(i, 13) = "" Then
strMsg = strMsg + "第" + CStr(i) + "行條碼(" + mf1.TextMatrix(i, 1) + ")中的物品(" + productCode + ")沒有登記" + vbCrLf
ElseIf mf1.TextMatrix(i, 1) <> "" And mf1.TextMatrix(i, 6) = "" Then
strMsg = strMsg + "第" + CStr(i) + "行條碼(" + mf1.TextMatrix(i, 1) + ")無效(不能從中讀取凈重）" + vbCrLf
End If
Next i
If Not hasDtl Then
MsgBox "沒有數據可保存，請輸入明細!", vbCritical, "警告"
Exit Sub
End If
If hasDtl Then
rsMaster.AddNew
' 店鋪(倉庫)標識
rsMaster.Fields("store") = g_store
rsMaster.Fields("billType") = m_billType
' 單據ID--主關鍵字
If billNo.Text <> "" Then rsMaster.Fields("billId") = billId
If takeunitName.Text <> "" Then rsMaster.Fields("takeunit") = txttakeunit.Text
If handler.Text <> "" Then rsMaster.Fields("handler") = handler.Text
If billDate.Text <> "" Then rsMaster.Fields("billDate") = CDate(billDate.Text) ' Now 'billDate.Text
If billNo.Text <> "" Then rsMaster.Fields("billNo") = billNo.Text
' If txtPrevBillNo.Text <> "" Then rsMaster.Fields("rsvFld1") = txtPrevBillNo.Text
rsMaster.Update
End If
DataMaster.RecordSource = sqlMaster + sqlOrderBy
DataMaster.Refresh
DataMaster.Recordset.FindFirst (" hpos_StockOutBill_Master.billId='" + billId + "'")
rsMaster.Close
rs1.Close
isAdd = False
strMsg = strMsg + ""
If strMsg <> "" Then
strMsg = "保存成功，以下條碼因為沒有登記或者無效而沒有保存。" + vbCrLf + "請記錄以下條碼讓超級管理員登記之后在出庫管理中補錄。" + vbCrLf + vbCrLf + strMsg + vbCrLf
Else
strMsg = "保存成功！"
End If
MsgBox strMsg, vbInformation, "提示"
SSTab1.Tab = 0
'清空數據
clearData mf1
takeunitName.Text = "": handler.Text = ""
' Me.txtPrevBillNo.Text = ""
billNo.Enabled = True: billNo.Text = ""
text1.Visible = False: gridCustomer.Visible = False '設置控件不可見
enableControls (False)
End Sub
Private Sub Comqx_Click() '取消操作
takeunitName.Text = "": handler.Text = ""
' Me.txtPrevBillNo.Text = ""
clearData mf1
takeunitName.Enabled = False: handler.Enabled = False
enableControls (False)
SSTab1.Tab = 0
' cmdEdit.Enabled = True
If DataMaster.Recordset.EOF Then
cmdEdit.Enabled = True
End If
End Sub
Private Sub Comend_Click()
frm_main.Enabled = True
Unload Me
End Sub
Private Sub text1_Validate(Cancel As Boolean)
If Len(Trim(text1.Text)) = g_barcode_length And mf1.col = 1 Then
Call fillDataFromBarcode
mf1.row = mf1.row - 1
ElseIf mf1.col = 1 And Trim(text1.Text) <> "" Then
MsgBox "條形碼長度必須為" & CStr(g_barcode_length) & "位", vbCritical, "警告"
Cancel = True
End If
End Sub
' 校驗某列的數據輸入是否有效;diffRow:0－表示當前行，－1表示上一行，1表示下一行。
Private Function checkData(col As Integer, colName As String, diffRow As Integer) As Boolean
If mf1.row > mf1.FixedRows - 1 Then
If Not Trim(mf1.TextMatrix(mf1.row, 1)) = "" And (mf1.col = col Or mf1.col = 1) And Not IsNumeric(Mid(Trim(mf1.TextMatrix(mf1.row, 1)), g_barcode_weight_start, g_barcode_length - g_barcode_weight_start)) Then
MsgBox colName + "必須為數值！", vbCritical, "輸入錯誤"
If mf1.row > 1 Then
mf1.row = mf1.row + diffRow
text1.Visible = True
text1.SetFocus
text1.SelStart = 0
text1.SelLength = Len(text1.Text)
Exit Function
End If
checkData = False
Else
checkData = True
End If
End If
End Function
Private Sub clearData(msfg As MSFlexGrid)
' For r = mf1.FixedRows To mf1.Rows - mf1.FixedRows
' For c = mf1.FixedCols To mf1.Cols - mf1.FixedCols
' mf1.TextMatrix(r, c) = ""
' Next
' Next
For r = msfg.FixedRows To msfg.rows - msfg.FixedRows
For c = msfg.FixedCols To msfg.cols - msfg.FixedCols
msfg.TextMatrix(r, c) = ""
Next
Next
End Sub
Private Sub fillTotalDataFromDtlData()
clearData msfgTtl
Dim ttlQty As Double
ttlQty = 0 '總件數
For r = mf1.FixedRows To mf1.rows - mf1.FixedRows
' 只對存在的物料進行總凈重、皮重等的累加
If mf1.TextMatrix(r, 13) <> "" Then
' 求總件數
ttlQty = ttlQty + Val(mf1.TextMatrix(r, 10))
For i = msfgTtl.FixedRows To msfgTtl.rows - msfgTtl.FixedRows
If msfgTtl.TextMatrix(i, 10) = mf1.TextMatrix(r, 13) Then
'對于存在的物料(productId相等)總凈重、皮重等累加
msfgTtl.TextMatrix(i, 6) = Format(Val(msfgTtl.TextMatrix(i, 6)) + Val(mf1.TextMatrix(r, 6)) * Val(mf1.TextMatrix(r, 10)), g_barcode_weight_scale) '總凈重
msfgTtl.TextMatrix(i, 7) = Format(Val(msfgTtl.TextMatrix(i, 7)) + Val(mf1.TextMatrix(r, 8)), g_barcode_weight_scale) '金額
msfgTtl.TextMatrix(i, 8) = Format(Val(msfgTtl.TextMatrix(i, 8)) + Val(mf1.TextMatrix(r, 10)), "#0") '件數
msfgTtl.TextMatrix(i, 9) = Format(Val(msfgTtl.TextMatrix(i, 9)) + Val(mf1.TextMatrix(r, 11)), g_barcode_weight_scale) '皮重
Exit For
Else '對于沒有的物料新增一行并填充數據
If msfgTtl.TextMatrix(i, 10) = "" Then
' msfgTtl.Rows = msfgTtl.Rows + 1
msfgTtl.TextMatrix(i, 1) = Mid(mf1.TextMatrix(r, 1), g_barcode_product_start, g_barcode_weight_start - g_barcode_product_start - g_barcode_sequenceno_len)
For col = 2 To 6
msfgTtl.TextMatrix(i, col) = mf1.TextMatrix(r, col)
Next
msfgTtl.TextMatrix(i, 6) = Format(Val(mf1.TextMatrix(r, 6)) * Val(mf1.TextMatrix(r, 10)), g_barcode_weight_scale) '總凈重
msfgTtl.TextMatrix(i, 7) = Format(mf1.TextMatrix(r, 8), g_barcode_weight_scale) '金額
msfgTtl.TextMatrix(i, 8) = Format(mf1.TextMatrix(r, 10), "#0") '件數
msfgTtl.TextMatrix(i, 9) = Format(mf1.TextMatrix(r, 11), g_barcode_weight_scale) '皮重
msfgTtl.TextMatrix(i, 10) = mf1.TextMatrix(r, 13) ' productId
Exit For
End If
End If
Next
End If
Next
' 設置界面總件數
Me.lblTtlQty.Caption = Format(ttlQty, "#0")
End Sub
' 激活或者去活相關控件
Private Sub enableControls(flag As Boolean)
takeunitName.Enabled = flag
handler.Enabled = flag
billNo.Enabled = flag
' 網格
text1.Enabled = flag
mf1.Enabled = flag
msfgTtl.Enabled = flag
' 按鈕
Combc.Enabled = flag
Comqx.Enabled = flag
cmdDeleteLine.Enabled = flag
Comdj.Enabled = Not flag
End Sub
Private Sub previewData1()
Dim excelSheet, sheet As New Excel.Worksheet
If Me.SSTab1.Tab = 0 Then
Me.SSTab1.Tab = 1
End If
If mf1.rows = mf1.FixedRows Then
MsgBox "沒有數據可打印，請先查詢！", vbInformation, "提示"
Exit Sub
End If
Dim dtlRow As Integer
Dim colCount As Integer
dtlRow = 3
colCount = 7 ' 總列數
Set sheet = createExcel()
' 設置表頭
Dim range As Excel.range
Set range = sheet.range(getExcelCellArea(1, 1) & ":" & getExcelCellArea(colCount, 1))
range.MergeCells = True
range.Value = "出 庫 單"
range.Font.Bold = True
range.Font.Size = 16
range.HorizontalAlignment = xlCenter
Set range = sheet.range(getExcelCellArea(1, 2) & ":" & getExcelCellArea(2, 2))
range.MergeCells = True
range.RowHeight = g_rowHeight
sheet.Cells(2, 1) = "客戶名稱：" + Me.takeunitName.Text
sheet.Cells(2, 3) = " 單據號："
sheet.Cells(2, 4) = Me.billNo
sheet.Cells(2, 5) = " 日 期："
sheet.Cells(2, 6) = Format(Me.billDate.Text, "yyyy-MM-dd")
Dim sql As String
Dim captionArray
Dim rs As Recordset
sql = "select P.productModel,P.productSpecs as specsModel,P.productUnit,axesWeight,qty*pieceQty as netWeight,qty*pieceQty+axesWeight from hpos_StockOutBill_dtl as D left join hpos_products as P on D.productId=P.productId where D.billId='" + txtBillId.Text + "'"
sql = sql + " order by int(MID(D.dtlId,len(D.billId)+2,len(D.dtlId)-len(D.billId)-1))"
captionArray = Array("型號", "規格", "單 位", "皮 重", "凈 重", "毛 重")
Set rs = g_db.OpenRecordset(sql)
Set excelSheet = sqlDataToExcel(rs, captionArray, "編號", dtlRow, sheet)
' 設置某列的格式
Dim i As Integer
For i = 5 To 7
Set range = excelSheet.range(getExcelCellArea(i, dtlRow + mf1.FixedRows) & ":" & getExcelCellArea(i, dtlRow + getValidRows(mf1) - mf1.FixedRows))
range.NumberFormatLocal = g_barcode_weight_scale + "_ "
Next i
' 匯總數據起始行
dtlRow = rs.RecordCount + dtlRow + 2
Set range = excelSheet.range(getExcelCellArea(1, dtlRow - 1) & ":" & getExcelCellArea(colCount, dtlRow - 1))
range.MergeCells = True
range.Value = " 累 計 "
range.Font.Bold = True
range.Font.Size = 14
' range.HorizontalAlignment = xlCenter
Dim eSheet As New Excel.Worksheet
Set eSheet = excelSheet
sql = "select SUM(pieceQty),P.productModel,P.productSpecs,P.productUnit,SUM(pieceQty*axesWeight),SUM(qty),SUM(qty*pieceQty+axesWeight) from hpos_StockOutBill_dtl as D left join hpos_products as P on D.productId=P.productId where D.billId='" + txtBillId.Text + "' GROUP BY P.productModel,P.productSpecs,P.productUnit "
captionArray = Array("總數", "型號", "規格", "單 位", "皮 重", "凈 重", "毛 重")
Set rs = g_db.OpenRecordset(sql)
Set eSheet = sqlDataToExcel(rs, captionArray, "", dtlRow, eSheet)
' 設置某列的格式
For i = 5 To 7
Set range = eSheet.range(getExcelCellArea(i, dtlRow + msfgTtl.FixedRows) & ":" & getExcelCellArea(i, dtlRow + getValidRows(msfgTtl) - msfgTtl.FixedRows))
range.NumberFormatLocal = g_barcode_weight_scale + "_ "
Next i
' 報表打印中加入總件數
Dim currentRow As Long
currentRow = rs.RecordCount + dtlRow + 2
Set range = sheet.range(getExcelCellArea(1, currentRow - 1) & ":" & getExcelCellArea(2, currentRow - 1))
range.MergeCells = True
eSheet.Cells(currentRow - 1, 1) = " " + lblTtlQtyCaption.Caption + Me.lblTtlQty.Caption
Set range = eSheet.range(getExcelCellArea(2, currentRow - 1) & ":" & getExcelCellArea(2, currentRow - 1))
range.NumberFormatLocal = "0_ "
range.RowHeight = g_rowHeight
Set range = eSheet.range(getExcelCellArea(1, 1), getExcelCellArea(colCount, currentRow))
autoFitSize range
' eSheet.PageSetup.Orientation = xlLandscape
rs.Close
eSheet.Cells.PrintOut
End Sub
Private Sub previewData0()
Dim excelSheet, sheet As New Excel.Worksheet
If Me.SSTab1.Tab = 0 Then
Me.SSTab1.Tab = 1
End If
If mf1.rows = mf1.FixedRows Then
MsgBox "沒有數據可打印，請先查詢！", vbInformation, "提示"
Exit Sub
End If
Dim dtlRow As Integer
dtlRow = 3
Set sheet = createExcel()
Set excelSheet = multiGridDataToExcel(mf1, dtlRow, sheet)
Set sheet = Nothing
' 設置第一列的寬度
excelSheet.Columns(getExcelColId(1) & ":" & getExcelColId(1)).ColumnWidth = 13
excelSheet.Columns(getExcelColId(3) & ":" & getExcelColId(3)).ColumnWidth = 15
Dim range As Excel.range
Set range = excelSheet.range(getExcelCellArea(1, 1) & ":" & getExcelCellArea(getShowDataCols(mf1), 1))
range.MergeCells = True
range.Value = "出 庫 單"
range.Font.Bold = True
range.Font.Size = 14
range.HorizontalAlignment = xlCenter
excelSheet.Cells(2, 1) = "客戶名稱："
excelSheet.Cells(2, 2) = Me.takeunitName.Text
excelSheet.Cells(2, 4) = "單據編號："
excelSheet.Cells(2, 5) = Me.billNo
' 加打印日期
excelSheet.Cells(2, 7) = "出庫日期："
excelSheet.Cells(2, 8) = Format(Me.billDate.Text, "yyyy-MM-dd")
excelSheet.Columns(getExcelColId(8) & ":" & getExcelColId(8)).ColumnWidth = 10
' 設置某列的格式
Set range = excelSheet.range(getExcelCellArea(6, dtlRow + mf1.Fi?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -