dlg_incomebill.frm

仓库扫描管理系统

    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 = ""
    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 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 = ""
     text1.Visible = False: gridCustomer.Visible = False     '设置控件不可见
    enableControls (False)
End Sub
Private Sub Comqx_Click()      '取消操作
     supplierName.Text = "": handler.Text = ""
    clearData mf1
    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)), 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
    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(pieceQty*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 + 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
    With eSheet.PageSetup
        .PrintTitleRows = "$1:$3"
        .PrintTitleColumns = ""
    End With
    eSheet.Cells.PrintOut
End Sub
'  第二个用户输出格式
Private Sub previewData2()
    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 Long
    Dim colCount As Integer
    Dim bPrintTotal  '  打印累计项
    bPrintTotal = MsgBox("需要打印(另起一页)累计数据吗？", vbYesNo + vbQuestion + vbDefaultButton1, "提示")
    colCount = 7    ' 总列数
    Set sheet = createExcel()
    '   设置表头
    Dim range As Excel.range
    Set range = sheet.range(getExcelCellArea(1, 1) & ":" & getExcelCellArea(CInt(g_billColCount), 1))
    setCompanyNameOfReport range
    Set range = sheet.range(getExcelCellArea(1, 2) & ":" & getExcelCellArea(CInt(g_billColCount), 2))
    setRangeFormat range, "入 库 单", True, 14, Excel.Constants.xlCenter
    dtlRow = 3
    Set range = sheet.range(getExcelCellArea(1, dtlRow) & ":" & getExcelCellArea(4, dtlRow))
    range.RowHeight = g_rowHeight
    setRangeFormat range, "供货单位：" + Me.supplierName.Text, True, 11, Excel.Constants.xlLeft
    Set range = sheet.range(getExcelCellArea(5, dtlRow) & ":" & getExcelCellArea(7, dtlRow))
    setRangeFormat range, "日期：" + Format(Me.billDate.Text, "yyyy-MM-dd"), True, 11, Excel.Constants.xlCenter
    Set range = sheet.range(getExcelCellArea(8, dtlRow) & ":" & getExcelCellArea(12, dtlRow))
    setRangeFormat range, "净重单位：Kg", True, 11, Excel.Constants.xlRight
    
    dtlRow = 4
    Set range = sheet.range(getExcelCellArea(1, dtlRow) & ":" & getExcelCellArea(4, dtlRow))
    range.RowHeight = g_rowHeight
    setRangeFormat range, "单 号：" + Me.billNo.Text, True, 11, Excel.Constants.xlLeft

    Dim sql As String
    Dim sqlrs As String
    Dim captionArray
    Dim rs