form_outadd.frm

仓库扫描管理系统

Private Sub clearData(msfg As MSFlexGrid)
    If msfg.Name = "mf1" Then
        msfg.rows = msfg.FixedRows + 1
        msfg.TextMatrix(msfg.FixedRows, 0) = "1"
    End If
    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
'Private Sub fillTotalDataFromDtlData()
'    clearData msfgTtl
'    For r = mf1.FixedRows To mf1.Rows - mf1.FixedRows
'        '  只对存在的物料进行总净重、皮重等的累加
'        If mf1.TextMatrix(r, 13) <> "" Then
'            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
'   增加的几个孔件
    Me.txtPrevBillNo.Enabled = flag
    Me.cmdPrevNo.Enabled = flag
    Me.cmdOutNo.Enabled = flag
    Me.txtPageNo.Enabled = flag
    Me.chkCompanyName.Enabled = flag
    Me.chkSkinWeight.Enabled = 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 previewData2()
    Dim excelSheet, sheet As New Excel.Worksheet
    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))
    If Me.chkCompanyName.Value = 1 Then
        setCompanyNameOfReport range
    End If
    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.takeunitName.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
'   续单号码
    Set range = sheet.range(getExcelCellArea(5, dtlRow) & ":" & getExcelCellArea(CInt(g_billColCount), dtlRow))
    range.RowHeight = g_rowHeight
    setRangeFormat range, "入库单号：" + Me.txtPrevBillNo.Text, True, 11, Excel.Constants.xlLeft
    Dim sql As String
    Dim sqlrs As String
    Dim captionArray
    Dim rs As Recordset
    '   明细
    sql = "select P.productModel,P.productSpecs,P.productUnit,axesWeight,qty*pieceQty as netWeight,qty*pieceQty+axesWeight,D.productId,D.rsvFld1 from hpos_StockOutBill_Dtl as D left join hpos_products as P on D.productId=P.productId where D.billId='" + txtBillId.Text + "'"
    '   按照产品规格、型号分组汇总
    sqlrs = "select P.productModel,P.productSpecs,SUM(qty*pieceQty) as netWeight,SUM(pieceQty) as amount,SUM(qty*pieceQty+axesWeight) as ttlWeight,D.productId from hpos_StockOutBill_Dtl as D left join hpos_products as P on D.productId=P.productId where D.billId='" + Me.txtBillId.Text + "'"
    '  组装SQL
    Dim unionSQl As String
    Dim i As Integer
    Dim productList As Variant
    productList = getProductList()
    If IsArray(productList) Then
        unionSQl = ""
        For i = LBound(productList) To UBound(productList)
            If IsEmpty(productList(i)) Then
                Exit For
            End If
            If i > LBound(productList) Then
                unionSQl = unionSQl + " UNION ALL "
            End If
            unionSQl = unionSQl + sqlrs + " and D.productId=" + productList(i) + " GROUP BY D.productId,P.productModel,P.productSpecs,P.productUnit "
        Next
    End If
    sqlrs = unionSQl
    Set rs = g_db.OpenRecordset(sqlrs)
    dtlRow = 4
    Set excelSheet = sqlDataTo6ColsExcel(rs, CInt(dtlRow), sheet, sql)
'   设置经手人以及复核人
    dtlRow = g_curMaxOutputRow + 1
    Set range = sheet.range(getExcelCellArea(1, dtlRow) & ":" & getExcelCellArea(2, dtlRow))
    setRangeFormat range, "收货单位及经手人", False, 11, Excel.Constants.xlRight
    Set range = sheet.range(getExcelCellArea(5, dtlRow) & ":" & getExcelCellArea(6, dtlRow))
    setRangeFormat range, "复核", False, 11, Excel.Constants.xlRight
    Set range = sheet.range(getExcelCellArea(9, dtlRow) & ":" & getExcelCellArea(12, dtlRow))
    setRangeFormat range, "送货单位及经手人", False, 11, Excel.Constants.xlCenter
'    ' 设置某列的格式
'    Dim i As Integer
    Dim currentRow As Long
    dtlRow = dtlRow + 2
    currentRow = dtlRow - 2
    Dim eSheet As New Excel.Worksheet
    Set eSheet = excelSheet
    Set range = eSheet.range(getExcelCellArea(1, 1), getExcelCellArea(CInt(g_billColCount), currentRow))
    autoFitSize range
    setColWidth eSheet
    rs.Close

'   设置表头和页码(页眉)
    With eSheet.PageSetup
        .PrintTitleRows = "$1:$4"
        .PrintTitleColumns = ""
        .RightHeader = Me.txtPageNo.Text                  '  "第 &P 页，共 &N 页"
        .LeftMargin = Application.InchesToPoints(0.55)
        .RightMargin = Application.InchesToPoints(0.35)
        .TopMargin = Application.InchesToPoints(0.59)
        .BottomMargin = Application.InchesToPoints(0.39)
        .HeaderMargin = Application.InchesToPoints(0.315)
        .FooterMargin = Application.InchesToPoints(0.15)
    End With
    eSheet.Cells.PrintOut
    '    打印累计项
    If bPrintTotal = vbYes Then
        printTotalData sqlrs
    End If
End Sub
'  另起一页打印累计数据
Private Sub printTotalData(sqlrs As String)
    Dim sheet As New Excel.Worksheet
    Dim rs As Recordset
    Set sheet = createExcel()
    Dim range As Excel.range
    Dim dtlRow As Long
    Dim colCount As Integer
    Dim quotiety As Double
    quotiety = 1.5
    colCount = g_billColCount
    '   设置表头
    Set range = sheet.range(getExcelCellArea(1, 1) & ":" & getExcelCellArea(CInt(g_billColCount), 1))
    If Me.chkCompanyName.Value = 1 Then
        setCompanyNameOfReport range
    End If
    range.Font.Size = range.Font.Size * quotiety
    Set range = sheet.range(getExcelCellArea(1, 2) & ":" & getExcelCellArea(CInt(g_billColCount), 2))
    setRangeFormat range, "出 库 单", True, 14, Excel.Constants.xlCenter
    range.Font.Size = range.Font.Size * quotiety
    dtlRow = 3
    Set range = sheet.range(getExcelCellArea(1, dtlRow) & ":" & getExcelCellArea(4, dtlRow))
    range.RowHeight = g_rowHeight
    setRangeFormat range, "收货单位：" + Me.takeunitName.Text, True, 11, Excel.Constants.xlLeft
    range.Font.Size = range.Font.Size * quotiety
    Set range = sheet.range(getExcelCellArea(5, dtlRow) & ":" & getExcelCellArea(7, dtlRow))
    setRangeFormat range, "日期：" + Format(Me.billDate.Text, "yyyy-MM-dd"), True, 11, Excel.Constants.xlCenter
    range.Font.Size = range.Font.Size * quotiety
    Set range = sheet.range(getExcelCellArea(8, dtlRow) & ":" & getExcelCellArea(12, dtlRow))
    setRangeFormat range, "净重单位：Kg", True, 11, Excel.Constants.xlRight
    range.Font.Size = range.Font.Size * quotiety
    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
    range.Font.Size = range.Font.Size * quotiety
'   续单号码
    Set range = sheet.range(getExcelCellArea(5, dtlRow) & ":" & getExcelCellArea(CInt(g_billColCount), dtlRow))
    range.RowHeight = g_rowHeight
    setRangeFormat range, "入库单号：" + Me.txtPrevBillNo.Text, True, 11, Excel.Constants.xlLeft
    range.Font.Size = range.Font.Size * quotiety
'  设置累计项
    Dim eSheet  As New Excel.Worksheet
    Dim currentRow As Long
    Set eSheet = sheet
    dtlRow = dtlRow + 2
    Set range = eSheet.range(getExcelCellArea(1, dtlRow - 1) & ":" & getExcelCellArea(colCount, dtlRow - 1))
    setRangeFormat range, "累   计(单号：" + Me.billNo.Text + ")", True, 14, Excel.Constants.xlCenter
    range.Font.Size = range.Font.Size * quotiety
    captionArray = Array("型号", "规格(mm)", "净重(KG)", "箱/件数")
    Set rs = g_db.OpenRecordset(sqlrs)
    Set eSheet = sqlTotalDataToExcel_2nd(rs, captionArray, CInt(dtlRow), eSheet)
    currentRow = rs.RecordCount + dtlRow + 2
    Set range = eSheet.range(getExcelCellArea(1, currentRow) & ":" & getExcelCellArea(6, currentRow))
    setRangeFormat range, "制表：", False, 11, Excel.Constants.xlLeft
    range.Font.Size = range.Font.Size * quotiety
    Set range = eSheet.range(getExcelCellArea(7, currentRow) & ":" & getExcelCellArea(12, currentRow))
    setRangeFormat range, "复核：", False, 11, Excel.Constants.xlLeft
    range.Font.Size = range.Font.Size * quotiety
    Set range = eSheet.range(getExcelCellArea(1, 1), getExcelCellArea(CInt(g_billColCount), currentRow))
    autoFitSize range
    range.RowHeight = 28
    rs.Close
'   设置表头和页码(页眉)
    With eSheet.PageSetup
        .PrintTitleRows = "$1:$4"
        .PrintTitleColumns = ""
        .RightHeader = Me.txtPageNo.Text            ' "第 &P 页，共 &N 页"
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesTall = 1
    End With
    eSheet.Cells.PrintOut
End Sub

'   获取单据中的产品ID(productId)列表
Private Function getProductList() As Variant
    Dim productIdList(0 To 30)
    m_productCount = 0
    For i = msfgTtl.FixedRows To msfgTtl.rows - msfgTtl.FixedRows
        If msfgTtl.TextMatrix(i, 10) <> "" Then
            productIdList(m_productCount) = msfgTtl.TextMatrix(i, 10)
            m_productCount = m_productCount + 1
        Else
            Exit For
        End If
    Next
    getProductList = productIdList
End Function

Private Sub txtPrevBillNo_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyPageDown Then     '按PageDown键

    End If
End Sub