modulemain.bas

仓库扫描管理系统

    ' 格式四：条码格式2+重量/1000重量取条形码的第7位到第12位除以1000
    If intBarcodeFormat = 4 Then
        g_barcode_product_start = 3
        g_barcode_weight_start = 7
        g_barcode_weight_base = 1000
    End If
    
    ' 格式五：18位条码 重量/100 重量取条形码的第13位到第17位除以100
    '    18位条码:F1F2 CCCCC XXXXX  WWWWW CD
    '   X=编号;W=重量
    If intBarcodeFormat = 5 Then
        g_barcode_product_start = 3
        g_barcode_weight_start = 13
        g_barcode_weight_base = 100
    End If
    ' 格式六：18位条码 重量/1000 重量取条形码的第13位到第17位除以1000
    '    18位条码:F1F2 CCCCC XXXXX  WWWWW CD
    '   X=编号;W=重量
    If intBarcodeFormat = 6 Then
        g_barcode_product_start = 3
        g_barcode_weight_start = 13
        g_barcode_weight_base = 1000
    End If
    
    Dim strScale As String
    strScale = CStr(g_barcode_weight_base)
    g_barcode_weight_scale = "#0." + Mid(strScale, 2, Len(strScale) - 1)
End Sub
' 获取有效的行数,包括表头行数
Public Function getValidRows(flexGrd As MSFlexGrid) As Long
    Dim n, i As Integer
    n = 0
    For i = 0 To flexGrd.rows - 1
        If Trim(flexGrd.TextMatrix(i, 1)) <> "" Then
            n = n + 1
        End If
    Next i
    getValidRows = n
End Function
' 创建ExcelSheet
Public Function createExcel() As Excel.Worksheet
    Dim ExcelApp As New Excel.Application
    Dim ExcelBook As New Excel.Workbook
    Dim excelSheet As New Excel.Worksheet

    Set ExcelApp = CreateObject("Excel.Application")
    Set ExcelBook = ExcelApp.Workbooks.Add(1)
    Set excelSheet = ExcelBook.Worksheets(1)
    ExcelApp.Visible = True
    Set createExcel = excelSheet
End Function

' 将MSFlexGrid中的数据输出到Excel Sheet中，从Excel中的第dtlRow行开始填充MSFlexGrid中的数据
Public Function flexgridToExcel(flexGrd As MSFlexGrid, dtlRow As Integer) As Excel.Worksheet
    If flexGrd.rows = flexGrd.FixedRows Then
        Set flexgridToExcel = Null
        Exit Function
    End If
    
    Dim ExcelApp As New Excel.Application
    Dim ExcelBook As New Excel.Workbook
    Dim excelSheet As New Excel.Worksheet
    Dim i As Long
    Dim L As Long
    
'    Set ExcelSheet = sheet
    Set ExcelApp = CreateObject("Excel.Application")
    Set ExcelBook = ExcelApp.Workbooks.Add(1)
    Set excelSheet = ExcelBook.Worksheets(1)
    ExcelApp.Visible = True

    Dim col As Integer
    col = 0
' 只输出flexgrd中宽度大于零的列，第一列值为空的行的数据不输出
    For L = flexGrd.FixedCols To flexGrd.cols - flexGrd.FixedCols
     If flexGrd.ColWidth(L) > 0 Then
        col = col + 1
        For i = 0 To flexGrd.rows - flexGrd.FixedRows
            excelSheet.Cells(i + dtlRow, col) = flexGrd.TextMatrix(i, L) & ""
        Next i
     End If
    Next L
' 开始画边框线条，先选择要画边框的区域
    Dim range As Excel.range
    Set range = excelSheet.range(getExcelCellArea(1, CLng(dtlRow)) & ":" & getExcelCellArea(getShowDataCols(flexGrd), flexGrd.rows + CLng(dtlRow) - 1))
    drawBordersLine range
' 画边框线条结束
    Set flexgridToExcel = excelSheet
End Function

' 将MSFlexGrid中的数据输出到Excel Sheet中，从Excel中的第dtlRow行开始填充MSFlexGrid中的数据
Public Function multiGridDataToExcel(flexGrd As MSFlexGrid, dtlRow As Integer, sheet As Excel.Worksheet) As Excel.Worksheet
    If flexGrd.rows = flexGrd.FixedRows Then
        Set multiGridDataToExcel = Null
        Exit Function
    End If
    
    Dim excelSheet As New Excel.Worksheet
    Dim i As Long
    Dim L As Long
    
    Set excelSheet = sheet
    Dim col, row As Integer
    row = 0
' 只输出flexgrd中宽度大于零的列，当第1列(条码号)值为空的行的数据不输出
    For i = 0 To flexGrd.rows - flexGrd.FixedRows
        If Trim(flexGrd.TextMatrix(i, 1)) <> "" Then
            row = row + 1
            col = 0
            For L = flexGrd.FixedCols To flexGrd.cols - flexGrd.FixedCols
                If flexGrd.ColWidth(L) > 0 Then
                   col = col + 1
                   excelSheet.Cells(i + dtlRow, col) = flexGrd.TextMatrix(i, L) & ""
                End If
            Next L
        End If
    Next i
       

' 开始画边框线条，先选择要画边框的区域
    Dim range As Excel.range
    Set range = excelSheet.range(getExcelCellArea(1, CLng(dtlRow)) & ":" & getExcelCellArea(getShowDataCols(flexGrd), row + CLng(dtlRow) - 1))
    drawBordersLine range
' 画边框线条结束
    Set multiGridDataToExcel = excelSheet
End Function

' 画边框线条
Public Sub drawBordersLine(range As Excel.range)
    With range.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With range.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With range.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With range.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With range.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With range.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub
' 设置列高、自动调整字体大小等等
Public Sub autoFitSize(range As Excel.range)
'    range.HorizontalAlignment = xlGeneral
    range.VerticalAlignment = xlCenter
    range.EntireColumn.AutoFit
    range.RowHeight = g_rowHeight
    range.ShrinkToFit = True
End Sub
'  设置出入库单据的列宽
Public Sub setColWidth(sheet As Excel.Worksheet)
    Dim sColId As String
    Dim i As Long
    For i = 1 To g_billColCount
        sColId = getExcelColId(CInt(i))
        If (i Mod 2) = 0 Then
            sheet.Columns(sColId & ":" & sColId).ColumnWidth = 9.25
        Else
            sheet.Columns(sColId & ":" & sColId).ColumnWidth = 4
        End If
    Next
End Sub

Public Function getShowDataCols(mfg As MSFlexGrid)
    Dim cols As Integer
    Dim i As Integer
    cols = 0
    For i = mfg.FixedCols To mfg.cols - 1
        If mfg.ColWidth(i) > 0 Then
          cols = cols + 1
        End If
    Next i
    getShowDataCols = cols
End Function


' 根据行列号返回单元格表示
Public Function getExcelCellArea(col As Integer, row As Long) As String
    If getExcelColId(col) = "" Then
        getExcelCellArea = ""
    Else
        getExcelCellArea = getExcelColId(col) & CStr(row)
    End If
End Function
' A代表第一列，B代表第二列。。。。 只对1至26列进行转换
Public Function getExcelColId(col As Integer) As String
    If col > 0 And col <= 26 Then
        getExcelColId = Chr(col + 64)
    Else
        getExcelColId = ""
    End If
End Function

' 设置MSFlexGrid各列宽度
Public Sub setFlexGridColsWidth(arrayWidth, mfgStock As MSFlexGrid)
'    s = Array("500", "1600", "900", "1200", "900", "700", "450", "800", "800", "450", "700", "500", "1200", "1200", "0")
    Dim i As Integer
    For i = 0 To mfgStock.cols - 1
     mfgStock.ColWidth(i) = arrayWidth(i)
    Next i
End Sub
' 设置MSFlexGrid的表头
Public Sub setFlexGridHead(arrayHead, mfgStock As MSFlexGrid)
    Dim i As Integer
    For i = 0 To mfgStock.cols - 1
     mfgStock.TextMatrix(0, i) = arrayHead(i)
    Next i
End Sub
' 检验出库净重、件数、毛重是否超出库存 colArray 中的值分别为物料ID、物料编号、净重、件数、毛重的列号。
' 新增时billId为空；修改时不为空  修改时允许出库数量等于当前库存数量加上单据原来的出库数量
Public Function checkOutWeight(flexGrd As MSFlexGrid, colArray, billId As String) As String
    Dim i As Integer
    ' 净重、件数、毛重
    Dim netWeight, pQty, weight, D As Double
    Dim strMsg, productId, productCode As String
    netWeight = 0
    pQty = 0
    weight = 0
    strMsg = ""
    Dim rsWeight As Recordset
    For i = flexGrd.FixedRows To flexGrd.rows - 1
'        i -flexgrd.FixedRows
        productId = flexGrd.TextMatrix(i, colArray(0))
        productCode = flexGrd.TextMatrix(i, colArray(1))
        If productId <> "" Then
            Set rsWeight = g_db.OpenRecordset("SELECT * FROM V_currentStock where productId=" + CStr(productId))
            If rsWeight.RecordCount > 0 Then
              netWeight = rsWeight.Fields("netWeight")
              pQty = rsWeight.Fields("pQty")
              weight = rsWeight.Fields("netWeight") + rsWeight.Fields("axesTtlWeight")
            End If
'  允许出库的数据加上本单据原来的出库数据
            Set rsWeight = g_db.OpenRecordset("SELECT SUM(qty*pieceQty) as netWeight, SUM(pieceQty) as pQty, SUM(axesWeight) as aWeight FROM hpos_StockOutBill_Dtl  where billId='" + billId + "' and productId=" + CStr(productId) + " group by productId")
            If rsWeight.RecordCount > 0 Then
              netWeight = netWeight + rsWeight.Fields("netWeight")
              pQty = pQty + rsWeight.Fields("pQty")
              weight = weight + rsWeight.Fields("netWeight") + rsWeight.Fields("aWeight")
            End If
            rsWeight.Close
            ' 比较净重
            D = Val(flexGrd.TextMatrix(i, colArray(2)))
            
            If D > CSng(netWeight) Then
                strMsg = strMsg + "物料编号为【" + productCode + "】的累计净重(" + CStr(D) + ")超过库存净重(" + CStr(netWeight) + ")！" + vbCrLf
            End If
            ' 比较件数
            D = flexGrd.TextMatrix(i, colArray(3))
'            If D > pQty Then
'                strMsg = strMsg + "物料编号为【" + productCode + "】的累计件数(" + CStr(D) + ")超过库存件数(" + CStr(pQty) + ")！" + vbCrLf
'            End If
            
            ' 比较毛重
            D = flexGrd.TextMatrix(i, colArray(4))
'            If D > weight Then
'                strMsg = strMsg + "物料编号为【" + productCode + "】的累计毛重(" + CStr(D) + ")超过库存毛重(" + CStr(weight) + ")！" + vbCrLf
'            End If
       End If
    Next i
    If strMsg <> "" Then
        strMsg = "以下出库数据超出库存，请核查!" + vbCrLf + vbCrLf + strMsg
    End If
    checkOutWeight = strMsg
End Function

' 将sql结果集中的数据输出到Excel Sheet中，从Excel中的第dtlRow行开始填充String中的数据
Public Function sqlDataToExcel(rs As Recordset, captionArray, sequenceName As String, _
    dtlRow As Integer, sheet As Excel.Worksheet) As Excel.Worksheet
    If rs.RecordCount = 0 Then
        Set sqlDataToExcel = Null