📄 form_incomebill.frm
字号:
Exit Sub
End If
If IsNumeric(mf1.TextMatrix(mf1.row, 9)) And IsNumeric(mf1.TextMatrix(mf1.row, 10)) Then
mf1.TextMatrix(mf1.row, 11) = Val(mf1.TextMatrix(mf1.row, 9)) + Val(mf1.TextMatrix(mf1.row, 10)) * Val(mf1.TextMatrix(mf1.row, 6))
mf1.TextMatrix(mf1.row, 11) = Format(mf1.TextMatrix(mf1.row, 11), g_barcode_weight_scale)
End If
fillTotalDataFromDtlData
End If
End Sub
Private Sub Comdj_Click()
isAdd = True
SSTab1.Tab = 1
'设置控件有效或无效
enableControls (True)
'清空数据
txtSupplier.Text = ""
txtBillId.Text = ""
supplierName.Text = ""
handler.Text = g_userName
Me.txtStockDataNo.Text = ""
Me.txtPrevBillNo.Text = ""
billDate.Text = CStr(Now)
clearData mf1
clearData msfgTtl
supplierName.SetFocus
billNo.Text = getNextBillNo("hpos_StockIncomeBill_Master", "billNo")
End Sub
Private Sub Combc_Click()
Set rs1 = g_db.OpenRecordset("hpos_StockIncomeBill_Dtl", dbOpenTable)
Set rsMaster = g_db.OpenRecordset("hpos_StockIncomeBill_Master", dbOpenTable)
Dim hasDtl As Boolean
Dim billId As String
hasDtl = False
If isAdd = True Then
billId = CStr(getNextPK("hpos_StockIncomeBill_Master", "billId")) 'billNo.Text
txtBillId.Text = billId
Else
billId = txtBillId.Text
End If
Dim rsTmp As Recordset
Set rsTmp = g_db.OpenRecordset("select fullName,orgId,orgCode,shortenedform from hpos_organization " _
& "where orgType=1 and ((fullName = " + "'" + supplierName.Text + "" + "'" + ")) order by fullName")
If rsTmp.EOF Then
MsgBox "无此供应商,请按【PageDown】键选择!", vbCritical, "数据无效"
txtSupplier.Text = ""
supplierName.Text = ""
supplierName.SetFocus
supplierName.SelStart = 0
supplierName.SelLength = Len(supplierName.Text)
Exit Sub
Else
txtSupplier.Text = rsTmp.Fields("orgId")
End If
If billNo.Text = "" Then
MsgBox "单据编号不能为空!", vbCritical, "数据无效"
Exit Sub
End If
Set rsTmp = g_db.OpenRecordset("select * from hpos_StockIncomeBill_Master where billId<>'" + billId + "' and billType=" + CStr(m_billType) + " and billNo='" & billNo.Text & "'")
If rsTmp.RecordCount > 0 Then
MsgBox "单据编号已经存在,请输入其它!", vbCritical, "数据无效"
billNo.SetFocus
Exit Sub
End If
rsTmp.Close
Dim strMsg As String
strMsg = Trim(checkbarcodesRepeated(mf1))
If strMsg <> "" Then
' If MsgBox("有以下条形码编号重复:" + vbCrLf + strMsg + vbCrLf + "继续保存吗?", vbYesNo + vbQuestion + vbDefaultButton1, "提示") = vbNo Then
If MsgBox("红色显示部分条码重复,继续保存吗?", vbYesNo + vbQuestion + vbDefaultButton1, "提示") = vbNo Then
Exit Sub
End If
End If
strMsg = ""
Dim deleted As Boolean
deleted = False
For i = mf1.FixedRows To mf1.rows - mf1.FixedRows
If mf1.TextMatrix(i, 13) <> "" And mf1.TextMatrix(i, 6) <> "" Then
hasDtl = True
rs1.AddNew
If isAdd = False And deleted = False Then
Dim sql As String
sql = " delete from hpos_StockIncomeBill_Dtl where billId=" + Chr(34) + txtBillId.Text + Chr(34)
g_db.Execute sql
sql = " delete from hpos_StockIncomeBill_Master where billId=" + Chr(34) + txtBillId.Text + Chr(34)
g_db.Execute sql
deleted = True
End If
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 supplierName.Text <> "" Then rsMaster.Fields("supplier") = txtSupplier.Text
If handler.Text <> "" Then rsMaster.Fields("handler") = handler.Text
If txtStockDataNo.Text <> "" Then rsMaster.Fields("rsvFld3") = txtStockDataNo.Text
'Me.txtStockDataNo.Text = ""
If txtPrevBillNo.Text <> "" Then rsMaster.Fields("rsvFld1") = txtPrevBillNo.Text
If billDate.Text <> "" Then rsMaster.Fields("billDate") = CDate(billDate.Text) ' Now 'billDate.Text
If billNo.Text <> "" Then rsMaster.Fields("billNo") = billNo.Text
rsMaster.Update
End If
DataMaster.RecordSource = sqlMaster + sqlOrderBy
DataMaster.Refresh
DataMaster.Recordset.FindFirst (" hpos_StockIncomeBill_Master.billId='" + billId + "'")
rsMaster.Close
rs1.Close
isAdd = False
If strMsg <> "" Then
strMsg = "保存成功,以下条码因为没有登记或者无效而没有保存。" + vbCrLf + "请记录以下条码让超级管理员登记之后在出库管理中补录。" + vbCrLf + vbCrLf + strMsg + vbCrLf
Else
strMsg = "保存成功!"
End If
MsgBox strMsg, vbInformation, "提示"
' SSTab1.Tab = 0
' '清空数据
' clearData mf1
' supplierName.Text = "": handler.Text = ""
' billNo.Enabled = True: billNo.Text = ""
' Me.txtPrevBillNo.Text = ""
' text1.Visible = False: gridCustomer.Visible = False '设置控件不可见
' enableControls (False)
End Sub
Private Sub Comqx_Click() '取消操作
' supplierName.Text = "": handler.Text = ""
' Me.txtPrevBillNo.Text = ""
' clearData mf1
enableControls (False)
SSTab1.Tab = 0
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)), 3, 4)) 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)
supplierName.Enabled = flag
handler.Enabled = flag
txtStockDataNo.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.supplierName.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,P.productUnit,axesWeight,qty*pieceQty as netWeight,qty*pieceQty+axesWeight from hpos_StockIncomeBill_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(axesWeight),SUM(qty),SUM(qty*pieceQty+axesWeight) from hpos_StockIncomeBill_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 + getVal
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -