form_incomeadd.frm

仓库扫描管理系统

        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.supplierName.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.FixedRows) & ":" & getExcelCellArea(6, dtlRow + getValidRows(mf1) - mf1.FixedRows))
    range.NumberFormatLocal = g_barcode_weight_scale + "_ "
    Set range = excelSheet.range(getExcelCellArea(7, dtlRow + mf1.FixedRows) & ":" & getExcelCellArea(7, dtlRow + getValidRows(mf1) - mf1.FixedRows))
    range.NumberFormatLocal = g_barcode_weight_scale + "_ "
    Set range = excelSheet.range(getExcelCellArea(8, dtlRow + mf1.FixedRows) & ":" & getExcelCellArea(8, dtlRow + getValidRows(mf1) - mf1.FixedRows))
    range.NumberFormatLocal = "0_ "
    Set range = excelSheet.range(getExcelCellArea(9, dtlRow + mf1.FixedRows) & ":" & getExcelCellArea(9, dtlRow + getValidRows(mf1) - mf1.FixedRows))
    range.NumberFormatLocal = g_barcode_weight_scale + "_ "
    Set range = excelSheet.range(getExcelCellArea(1, dtlRow + mf1.FixedRows) & ":" & getExcelCellArea(1, dtlRow + getValidRows(mf1) - mf1.FixedRows))
    range.NumberFormatLocal = "000000"
    Dim col As Integer
    For col = 1 To getShowDataCols(mf1)
'        ExcelSheet.Columns(getExcelColId(col) & ":" & getExcelColId(col)).EntireColumn.AutoFit
        excelSheet.Columns(getExcelColId(col) & ":" & getExcelColId(col)).ShrinkToFit = False
    Next col
    ' 汇总数据起始行
    dtlRow = getValidRows(mf1) + dtlRow + 2
    Set range = excelSheet.range(getExcelCellArea(1, dtlRow - 1) & ":" & getExcelCellArea(getShowDataCols(msfgTtl), 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
    Set eSheet = multiGridDataToExcel(Me.msfgTtl, dtlRow, eSheet)
    Set excelSheet = Nothing
    ' 设置某列的格式
    Set range = eSheet.range(getExcelCellArea(6, dtlRow + msfgTtl.FixedRows) & ":" & getExcelCellArea(6, dtlRow + getValidRows(msfgTtl) - msfgTtl.FixedRows))
    range.NumberFormatLocal = g_barcode_weight_scale + "_ "
    Set range = eSheet.range(getExcelCellArea(7, dtlRow + msfgTtl.FixedRows) & ":" & getExcelCellArea(7, dtlRow + getValidRows(msfgTtl) - msfgTtl.FixedRows))
    range.NumberFormatLocal = "0_ "
    Set range = eSheet.range(getExcelCellArea(8, dtlRow + msfgTtl.FixedRows) & ":" & getExcelCellArea(8, dtlRow + getValidRows(msfgTtl) - msfgTtl.FixedRows))
    range.NumberFormatLocal = g_barcode_weight_scale + "_ "
' 报表打印中加入总件数
    Dim currentRow As Long
    currentRow = getValidRows(msfgTtl) + dtlRow + 1
    eSheet.Cells(currentRow - 1, 6) = lblTtlQtyCaption.Caption
    eSheet.Cells(currentRow - 1, 7) = Me.lblTtlQty.Caption

    eSheet.Cells(currentRow, 1) = "验收员："
    eSheet.Cells(currentRow, 2) = Me.handler.Text
    eSheet.Cells(currentRow, 7) = "打印日期："
    eSheet.Cells(currentRow, 8) = Format(Date, "yyyy-MM-dd")
    Set range = eSheet.range(getExcelCellArea(1, 1), getExcelCellArea(mf1.cols, currentRow))
    autoFitSize range
    eSheet.PageSetup.Orientation = xlLandscape
    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.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 As Recordset
    '   明细
    sql = "select P.productModel,P.productSpecs,P.productUnit,axesWeight,qty*pieceQty as netWeight,qty*pieceQty+axesWeight,D.productId,D.rsvFld1 from hpos_StockIncomeBill_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_StockIncomeBill_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 = "第 &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.supplierName.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
'  设置累计项
    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
'    If g_outputSkinWeight = True Then
'        captionArray = Array("型号", "规格(mm)", "净重(KG)", "毛重(KG)", "箱/件数")
'    Else
        captionArray = Array("型号", "规格(mm)", "净重(KG)", "箱/件数")
'    End If
    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 = "第 &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键
        Load dlg_incomeBill
        dlg_incomeBill.Show vbModal, Me
        m_prevBillNo = getPrevBillMaxBoxNo(Me.txtPrevBillNo.Text, True)
        setGridSequence Me.mf1, m_prevBillNo + 1, 0
    End If
End Sub