modulemain.bas

仓库扫描管理系统

        Exit Function
    End If
    
    Dim excelSheet As New Excel.Worksheet
    Dim i As Long
    Dim L As Long
    
    Set excelSheet = sheet
    Dim col, cols, rows, row As Integer
    row = dtlRow
    col = 0     ' 起始列
    rows = rs.RecordCount + 1
    cols = rs.Fields.Count
    If sequenceName <> "" Then
        col = col + 1   ' 起始列
        cols = cols + 1
        excelSheet.Cells(dtlRow, col) = sequenceName & ""       ' 输出序号标题
    End If
    
'  输出各列的标题
    For i = 1 To rs.Fields.Count
        excelSheet.Cells(dtlRow, i + col) = CStr(captionArray(i - 1)) & ""
    Next i
'   输出各行数据
    row = 0
    Do While Not rs.EOF
        row = row + 1
        If sequenceName <> "" Then
            excelSheet.Cells(dtlRow + row, col) = CStr(row) & ""
        End If
        For i = 1 To rs.Fields.Count
            excelSheet.Cells(dtlRow + row, i + col) = CStr(rs.Fields(i - 1)) & ""
        Next i
        rs.MoveNext
    Loop
' 开始画边框线条，先选择要画边框的区域
    Dim range As Excel.range
    Set range = excelSheet.range(getExcelCellArea(1, CLng(dtlRow)) & ":" & getExcelCellArea(CLng(cols), CLng(dtlRow + rs.RecordCount)))
    drawBordersLine range
' 画边框线条结束
    Set sqlDataToExcel = excelSheet
End Function
' 设置表头报表名称
Public Sub setRangeFormat(range As Excel.range, cellValue As String, fontBold As Boolean, fontSize As Integer, hAlign As Integer)
    range.MergeCells = True
    range.Value = cellValue
    range.Font.Bold = fontBold
    range.Font.Size = fontSize
    range.HorizontalAlignment = hAlign
End Sub
' 设置表头公司名称
Public Sub setCompanyNameOfReport(range As Excel.range)
    range.MergeCells = True
    range.Value = g_companyName
    range.Font.Bold = True
    range.Font.Size = 16
    range.HorizontalAlignment = xlCenter
End Sub
' 将结果集中的数据输出到Excel Sheet中，从Excel中的第dtlRow行开始填充String中的数据；
'sql是没有排序的数据源，rs已经排序
Public Function sqlDataTo6ColsExcel(rs As Recordset, dtlRow As Integer, _
        sheet As Excel.Worksheet, sql As String) As Excel.Worksheet
    If rs.RecordCount = 0 Then
        Set sqlDataTo6ColsExcel = Null
        Exit Function
    End If
    Dim captionArray
    Dim productId As String
    Dim range As Excel.range
    Dim rsDtl As Recordset
    Dim excelSheet As New Excel.Worksheet
    Dim i As Long
'    Dim cols As Long
    Dim rows As Long
    Dim row As Long
    Dim borderStartRow As Long
    Dim borderEndRow As Long
    Dim rowsPerProduct As Long
    Dim strGroupContent As String
    Dim productSN As Integer '  第几个产品
    captionArray = Array("编号", "净 重", "编号", "净 重", "编号", "净 重", "编号", "净 重", "编号", "净 重", "编号", "净 重")
    Set excelSheet = sheet
    row = dtlRow   '当前行号
    productId = ""
    productSN = 0
    Do While Not rs.EOF
    '  根据不同的产品编号输出表格
        productSN = productSN + 1
        row = row + 1
        productId = Trim(CStr(rs.Fields("productId")))
    '  如果不是第一个客户的版本就按照编号排序
        Set rsDtl = g_db.OpenRecordset(sql + "  and D.productId=" + productId + " order by D.billId,CINT(D.rsvFld1)")
        Dim strSpace As String
        strSpace = Space(4)
        If g_outputSkinWeight = True Then
            strGroupContent = "型号：" + CStr(rs.Fields("productModel")) + strSpace _
                            & "规格(mm)：" + CStr(rs.Fields("productSpecs")) + strSpace _
                            & "净重(KG)：" + Format(rs.Fields("netWeight"), g_barcode_weight_scale) + strSpace _
                            & "毛重(KG)：" + Format(rs.Fields("ttlWeight"), g_barcode_weight_scale) + strSpace _
                            & "箱/件数：" + CStr(rs.Fields("amount"))
        Else
            strGroupContent = "型号：" + CStr(rs.Fields("productModel")) + strSpace _
                            & "规格(mm)：" + CStr(rs.Fields("productSpecs")) + strSpace _
                            & "净重(KG)：" + Format(rs.Fields("netWeight"), g_barcode_weight_scale) + strSpace _
                            & "箱/件数：" + CStr(rs.Fields("amount"))
        End If
        Set range = sheet.range(getExcelCellArea(1, row) & ":" & getExcelCellArea(CInt(g_billColCount), row))
        setRangeFormat range, strGroupContent, True, 11, Excel.Constants.xlCenter
' ==================================================  '
        '  另起一行 输出各列的标题
        row = row + 1
        borderStartRow = row
        For i = 1 To g_billColCount
            excelSheet.Cells(row, i) = CStr(captionArray(i - 1)) & ""
'            If (i Mod 2) = 0 Then
'               excelSheet.Cells(row, i).Font.Bold = True
'                excelSheet.Cells(row, i).Font.Color = &HFF0000
'            End If
        Next i
        Set range = sheet.range(getExcelCellArea(1, row) & ":" & getExcelCellArea(CInt(g_billColCount), row))
        range.Font.Size = 11
        
        Dim sequenceNo As Integer
        Dim col As Integer
        sequenceNo = 0
        row = row + 1
        Do While Not rsDtl.EOF
            sequenceNo = sequenceNo + 1
            col = sequenceNo Mod (g_billColCount / 2)
            If col = 0 Then
                col = g_billColCount / 2
            End If
            Set range = sheet.range(getExcelCellArea(2 * col - 1, row + CLng((sequenceNo - 1) \ (g_billColCount / 2))) & ":" & getExcelCellArea(2 * col - 1, row + CLng((sequenceNo - 1) \ (g_billColCount / 2))))
            range.NumberFormatLocal = "0_ "
'            setRangeFormat range, CStr(sequenceNo), False, 11, Excel.Constants.xlRight
            setRangeFormat range, rsDtl.Fields("rsvFld1"), False, 11, Excel.Constants.xlRight
            Set range = sheet.range(getExcelCellArea(2 * col, row + CLng((sequenceNo - 1) \ (g_billColCount / 2))) & ":" & getExcelCellArea(2 * col, row + CLng((sequenceNo - 1) \ (g_billColCount / 2))))
            range.NumberFormatLocal = g_barcode_weight_scale + "_ "
            setRangeFormat range, rsDtl.Fields("netWeight"), False, 11, Excel.Constants.xlRight
            range.Font.Bold = True
'            range.Font.Color = &HFF0000
            rsDtl.MoveNext
        Loop
        '  每个产品输出到Excel中所占的行数
        rowsPerProduct = CLng(rsDtl.RecordCount \ (g_billColCount / 2))
        If rsDtl.RecordCount Mod (g_billColCount / 2) <> 0 Then
            rowsPerProduct = rowsPerProduct + 1
        End If
        borderEndRow = borderStartRow + rowsPerProduct
        row = row + rowsPerProduct
        
        ' 画边框线
        Set range = excelSheet.range(getExcelCellArea(1, borderStartRow) & ":" & getExcelCellArea(CLng(g_billColCount), borderEndRow))
        drawBordersLine range
        
        rs.MoveNext
    Loop

    dtlRow = row
    g_curMaxOutputRow = row - 1
    Set sqlDataTo6ColsExcel = excelSheet
End Function
' 将sql结果集中的数据(仅用于累计项)输出到Excel Sheet中，从Excel中的第dtlRow行开始填充String中的数据
' 仅仅适用于第二个客户，针对第二个客户表单要求定制，rs中的最后两列不输出，最后一列仅作排序用，不在报表中输出
Public Function sqlTotalDataToExcel_2nd(rs As Recordset, captionArray, _
    dtlRow As Integer, sheet As Excel.Worksheet) As Excel.Worksheet
    If rs.RecordCount = 0 Then
        Set sqlTotalDataToExcel_2nd = Null
        Exit Function
    End If
   
    Dim excelSheet As New Excel.Worksheet
    Dim range As Excel.range
    Dim i As Long
    Dim L As Long
    Dim quotiety As Double
    quotiety = 1.5
    
    Set excelSheet = sheet
    Dim col, cols, rows, row As Integer
    row = dtlRow
    col = 0     ' 起始列
    rows = rs.RecordCount + 1
    cols = UBound(captionArray) + 1   'rs.Fields.Count - 1
   Dim hAlign As Integer
   hAlign = Excel.Constants.xlCenter
   
'  输出各列的标题
    For i = 1 To cols
        Set range = sheet.range(getExcelCellArea(3 * (i - 1) + 1, CLng(dtlRow)) & ":" & getExcelCellArea(3 * i, CLng(dtlRow)))
        If i > 2 Then
            hAlign = Excel.Constants.xlRight
        End If
        setRangeFormat range, CStr(captionArray(i - 1)), False, 11, hAlign
        range.Font.Size = range.Font.Size * quotiety
    Next i
'   输出各行数据
    row = 0
    Do While Not rs.EOF
        row = row + 1
        hAlign = Excel.Constants.xlCenter
        For i = 1 To cols
            If i > 2 Then
                hAlign = Excel.Constants.xlRight
            End If
            Set range = sheet.range(getExcelCellArea(3 * (i - 1) + 1, CLng(dtlRow + row)) & ":" & getExcelCellArea(3 * i, CLng(dtlRow + row)))
            setRangeFormat range, CStr(rs.Fields(i - 1)), False, 11, hAlign
            range.Font.Size = range.Font.Size * quotiety
            If i = 3 Then
                range.NumberFormatLocal = g_barcode_weight_scale + "_ "
            End If
            If i = 4 Then
                range.NumberFormatLocal = "0_ "
            End If
        Next i
        rs.MoveNext
    Loop
    Set range = sheet.range(getExcelCellArea(1, CLng(dtlRow + rs.RecordCount + 1)) & ":" & getExcelCellArea(6, CLng(dtlRow + rs.RecordCount + 1)))
    setRangeFormat range, "合     计", True, 11, Excel.Constants.xlCenter
    range.Font.Size = range.Font.Size * quotiety
    Set range = sheet.range(getExcelCellArea(7, CLng(dtlRow + rs.RecordCount + 1)) & ":" & getExcelCellArea(9, CLng(dtlRow + rs.RecordCount + 1)))
    setRangeFormat range, "0.00", True, 11, Excel.Constants.xlRight
    range.Font.Size = range.Font.Size * quotiety
    range.FormulaR1C1 = "=SUM(R[-" + CStr(rs.RecordCount) + "]C:R[-1]C)"
    range.NumberFormatLocal = g_barcode_weight_scale + "_ "
    
    Set range = sheet.range(getExcelCellArea(10, CLng(dtlRow + rs.RecordCount + 1)) & ":" & getExcelCellArea(12, CLng(dtlRow + rs.RecordCount + 1)))
    setRangeFormat range, "0.00", True, 11, Excel.Constants.xlRight
    range.Font.Size = range.Font.Size * quotiety
    range.FormulaR1C1 = "=SUM(R[-" + CStr(rs.RecordCount) + "]C:R[-1]C)"
    range.NumberFormatLocal = "0_ "
' 开始画边框线条，先选择要画边框的区域
    Set range = excelSheet.range(getExcelCellArea(1, CLng(dtlRow)) & ":" & getExcelCellArea(CLng(cols * 3), CLng(dtlRow + rs.RecordCount + 1)))
    drawBordersLine range
' 画边框线条结束
    Set sqlTotalDataToExcel_2nd = excelSheet
End Function
'   根据单据ID获取最大箱号:isIncome 为true表示入库，false表示出库
Public Function getPrevBillMaxBoxNo(billNo As String, isIncome As Boolean) As Integer
    Dim rs As Recordset
    Dim sql As String
    If isIncome Then
        sql = "SELECT MAX(CINT(rsvFld1)) as boxNo FROM hpos_StockIncomeBill_Dtl WHERE billId in(SELECT DISTINCT billId FROM hpos_StockIncomeBill_Master WHERE billId='" + billNo + "' )"
    Else
        sql = "SELECT MAX(CINT(rsvFld1)) as boxNo FROM hpos_StockOutBill_Dtl WHERE billId in(SELECT DISTINCT billId FROM hpos_StockOutBill_Master WHERE billId='" + billNo + "' )"
    End If
    Set rs = g_db.OpenRecordset(sql)
    If rs.RecordCount <> 1 Or IsNull(rs.Fields("boxNo")) Then
        getPrevBillMaxBoxNo = 0     ' 默认为0
    Else
        getPrevBillMaxBoxNo = rs.Fields("boxNo")
    End If
End Function

'   设置MSFlexGrid的序号(即业务箱号):   startNo-起始序号；snCol－序号(即业务箱号的列号
Public Sub setGridSequence(grd As MSFlexGrid, startNo As Integer, snCol As Integer)
    Dim i As Integer
     For i = grd.FixedRows To grd.rows - grd.FixedRows
         grd.TextMatrix(i, snCol) = i - grd.FixedRows + startNo
     Next i
End Sub

'   将源表格srcFlxGrd中的数据追加到目标表格desFlxGrd中
Public Sub appendData(srcFlxGrd As MSFlexGrid, desFlxGrd As MSFlexGrid)
'   获取目标表格的起始行号：从该行开始追加数据
    Dim i, j, startRow As Integer
    startRow = desFlxGrd.rows - 1
    For i = desFlxGrd.rows - 1 To desFlxGrd.FixedRows Step -1
        '   如果条形码为空则起始行号减去1，否则退出循环
        If Trim(desFlxGrd.TextMatrix(i, 1)) = "" Then
            startRow = startRow - 1
        Else
            Exit For
        End If
    Next
    startRow = startRow + 1
    '   开始将源表格srcFlxGrd中的数据追加到目标表格desFlxGrd中
    For i = srcFlxGrd.FixedRows To srcFlxGrd.rows - 1
        If Trim(srcFlxGrd.TextMatrix(i, 1)) <> "" Then
'            Dim sequenceNo As String
'            sequenceNo = desFlxGrd.TextMatrix(startRow + i - srcFlxGrd.FixedRows, 0)
'            desFlxGrd.TextMatrix(startRow + i - srcFlxGrd.FixedRows, 0) = startRow + i - srcFlxGrd.FixedRows
            desFlxGrd.TextMatrix(startRow + i - srcFlxGrd.FixedRows, 0) = startRow + i - srcFlxGrd.FixedRows
            
            For j = 1 To srcFlxGrd.cols - 1
                desFlxGrd.TextMatrix(startRow + i - srcFlxGrd.FixedRows, j) = srcFlxGrd.TextMatrix(i, j)
            Next
            desFlxGrd.rows = desFlxGrd.rows + 1