oaminmodu.bas

一个OA办公自动化管理系统

    Exit Function
End Function
Public Function ServerBillNo(BillType As Integer, Optional ByVal Style As Integer = 0) As String
    Dim rstFirstChar As Recordset
    Dim strFirstChar As String
    ServerBillNo = ""
    Set rstFirstChar = New Recordset
    rstFirstChar.Open "Select FirstChar From Evidence_Type Where Type='" & BillType & "'", GetCNClient, adOpenForwardOnly
    
    If rstFirstChar.EOF Then
        Exit Function
    Else
        strFirstChar = rstFirstChar![FirstChar]
    End If
    
    If Style = 0 Then
    
        Set rstFirstChar = New Recordset
        rstFirstChar.Open "Select top 1 Evidence_Number From Inventory_Evidence Where left(Evidence_Number,2)='" & strFirstChar & "' and SubString(Evidence_Number,3,6)='" & Format(Date, "yymmdd") & "' Order by Evidence_Number Desc", GetCNClient, adOpenForwardOnly
        
        If rstFirstChar.EOF Then
            ServerBillNo = strFirstChar & Format(Date, "yymmdd") & "001"
        Else
            ServerBillNo = strFirstChar & Format(Date, "yymmdd") & Format(Val(Right(rstFirstChar![Evidence_Number], 3)) + 1, "000")
        End If
    
    Else

        Set rstFirstChar = New Recordset
        rstFirstChar.Open "Select top 1 Evidence_Number From Inventory_EvidenceMoney Where left(Evidence_Number,2)='" & strFirstChar & "' and SubString(Evidence_Number,3,6)='" & Format(Date, "yymmdd") & "' Order by Evidence_Number Desc", GetCNClient, adOpenForwardOnly
        
        If rstFirstChar.EOF Then
            ServerBillNo = strFirstChar & Format(Date, "yymmdd") & "001"
        Else
            ServerBillNo = strFirstChar & Format(Date, "yymmdd") & Format(Val(Right(rstFirstChar![Evidence_Number], 3)) + 1, "000")
        End If
    End If
    Set rstFirstChar = Nothing
    
    
End Function






Public Function NewBillNo(BillType As Integer, Optional ByVal Style As Integer = 0) As String
    Dim rstFirstChar As Recordset
    Dim strFirstChar As String
    NewBillNo = ""
    Set rstFirstChar = New Recordset
    rstFirstChar.Open "Select FirstChar From Evidence_Type Where Type='" & BillType & "'", GetCNClient, adOpenForwardOnly
    
    If rstFirstChar.EOF Then
        Exit Function
    Else
        strFirstChar = rstFirstChar![FirstChar]
    End If
    
    
    If Style = 0 Then
    
        Set rstFirstChar = New Recordset
        rstFirstChar.Open "Select top 1 Evidence_Number From Local_Inventory_Evidence Where left(Evidence_Number,3)='L' & '" & strFirstChar & "' and MId(Evidence_Number,4,6)='" & Format(Date, "yymmdd") & "' Order by Evidence_Number Desc", GetCNLocal, adOpenForwardOnly
        If Not rstFirstChar.EOF Then
            NewBillNo = "L" & strFirstChar & Format(Date, "yymmdd") & Format(Val(Right(rstFirstChar![Evidence_Number], 3)) + 1, "000")
        Else
            Set rstFirstChar = New Recordset
            rstFirstChar.Open "Select top 1 Evidence_Number From Inventory_Evidence Where left(Evidence_Number,2)='" & strFirstChar & "' and SubString(Evidence_Number,3,6)='" & Format(Date, "yymmdd") & "' Order by Evidence_Number Desc", GetCNClient, adOpenForwardOnly
            
            If rstFirstChar.EOF Then
                NewBillNo = "L" & strFirstChar & Format(Date, "yymmdd") & "001"
            Else
                NewBillNo = "L" & strFirstChar & Format(Date, "yymmdd") & Format(Val(Right(rstFirstChar![Evidence_Number], 3)) + 1, "000")
            End If
        End If
    Else
        Set rstFirstChar = New Recordset
        rstFirstChar.Open "Select top 1 Evidence_Number From Local_Inventory_EvidenceMoney Where left(Evidence_Number,3)='L' & '" & strFirstChar & "' and MId(Evidence_Number,4,6)='" & Format(Date, "yymmdd") & "' Order by Evidence_Number Desc", GetCNLocal, adOpenForwardOnly
        If Not rstFirstChar.EOF Then
            NewBillNo = "L" & strFirstChar & Format(Date, "yymmdd") & Format(Val(Right(rstFirstChar![Evidence_Number], 3)) + 1, "000")
        Else
            Set rstFirstChar = New Recordset
            rstFirstChar.Open "Select top 1 Evidence_Number From Inventory_EvidenceMoney Where left(Evidence_Number,2)='" & strFirstChar & "' and SubString(Evidence_Number,3,6)='" & Format(Date, "yymmdd") & "' Order by Evidence_Number Desc", GetCNClient, adOpenForwardOnly
            
            If rstFirstChar.EOF Then
                NewBillNo = "L" & strFirstChar & Format(Date, "yymmdd") & "001"
            Else
                NewBillNo = "L" & strFirstChar & Format(Date, "yymmdd") & Format(Val(Right(rstFirstChar![Evidence_Number], 3)) + 1, "000")
            End If
        End If

    End If
    Set rstFirstChar = Nothing
    
    
End Function

Public Function GetBillNo(BillType As Integer) As String
    strBillType = BillType
    frmBillNo.Show 1
    GetBillNo = strBillNo
End Function


Public Function ReadPower(BillName As String) As String
    Dim rstUserWork As Recordset
    On Error GoTo Err_ReadPower:
    ReadPower = ""
    
    Set rstUserWork = New Recordset
    rstUserWork.Open "Select * From PubOAUserWork Where UserID='" & LoginName & "' And FunctionID='" & BillName & "'", GetCNClient, adOpenForwardOnly
    If rstUserWork.EOF Then
        Exit Function
    Else
        ReadPower = ReadPower & IIf(rstUserWork![AllowNew] = 0, 0, 1)
        ReadPower = ReadPower & IIf(rstUserWork![AllowUpdate] = 0, 0, 1)
        ReadPower = ReadPower & IIf(rstUserWork![OnlyRead] = 0, 0, 1)
        ReadPower = ReadPower & IIf(rstUserWork![Check] = 0, 0, 1)
        ReadPower = ReadPower & IIf(rstUserWork![Post] = 0, 0, 1)
        ReadPower = ReadPower & IIf(rstUserWork![rs] = 0, 0, 1)
        
    End If
    Exit Function
Err_ReadPower:
    ReadPower = ""
    MisMsg "ReadPower Error" & Err.Description
    Exit Function
End Function


Public Function GetInvInfo() As String

    GetInvInfo = ""
    frmQueryWhere.Show 1
    GetInvInfo = strInvInfo

End Function

Public Function SaveProve(strBillNo As String, Optional Style As Integer = 0) As Integer

    SaveProve = 0
    On Error GoTo Err_SaveProve
    If Style = 0 Then
        If GetEvidenceCertificate(strBillNo) = 1 Then
            GetCNClient.Execute "Update Inventory_Evidence Set Style=5 where Evidence_Number='" & strBillNo & "'"
            'MisMsg ("凭证处理完成!")
        Else
            GetCNClient.Execute "Update Inventory_Evidence Set Style=4 where Evidence_Number='" & strBillNo & "'"
            MisMsg ("凭证处理完成!")
        
        End If
    Else
        If GetEvidenceCertificate(strBillNo) = 2 Then
            GetCNClient.Execute "Update Inventory_Evidence Set Style=4 where Evidence_Number='" & strBillNo & "'"
            MisMsg ("凭证处理完成!")
        End If

    End If
    SaveProve = 1
    Exit Function
Err_SaveProve:
    SaveProve = 0
    MisMsg "SaveProve Error:" & Err.Description
    Exit Function
End Function

Public Sub SizeLoad(rstData As Recordset, strSizeType As Integer, GridSize As MSDataGridLib.DataGrid)
Dim RstSizeType As Recordset, i As Integer, j As Integer, d As Integer, k As Integer

On Error GoTo Err_SizeLoad


    Set GridSize.DataSource = rstData
    'On Error Resume Next
    'and Attribute=1
    Set RstSizeType = New Recordset
    RstSizeType.Open "Select * from Mis_Size where Size_Type=" & strSizeType & "   and Attribute=1 Order by OrderBy", GetCNClient, adOpenStatic, adLockReadOnly
    
    Do While GridSize.Columns.Count > 1
      GridSize.Columns.Remove (1)
    
    Loop
        
    
    If strSizeType = 0 Then
        GridSize.Visible = False
    
    Else
        
        GridSize.Visible = True
    
        i = 1
        With RstSizeType
            If .RecordCount > 0 Then
               .MoveFirst
               d = .RecordCount
               Do Until .EOF
                    
                    k = GridSize.Columns.Count
                    GridSize.Columns.Add (k)
                    'Set C = DataGrid1.Columns.Add(DataGrid1.Columns.Count)
                    
                    GridSize.Columns(k).Visible = True
                    GridSize.Columns(k).Caption = Trim(![Description])
                    GridSize.Columns(k).DataField = Trim(![ID])
                    GridSize.Columns(k).NumberFormat = "#,##0"
                    GridSize.Columns(k).Width = GridSize.Width / d
                    
                  .MoveNext
               Loop
               GridSize.Columns(d).Width = GridSize.Width - GridSize.Columns(d).Width * (d - 1)
            End If
        End With
        GridSize.Columns.Remove 0
        'vbGridSize.ClearFields
        GridSize.HoldFields
        GridSize.ReBind
        i = GridSize.Height
        GridSize.RowHeight = i - 220   'vbGridSize.Height
        GridSize.AllowUpdate = True
        GridSize.Appearance = dbgFlat
        GridSize.AllowAddNew = False
        GridSize.AllowDelete = False
        GridSize.RecordSelectors = False
        GridSize.CurrentCellModified = True
        GridSize.EditActive = True
        GridSize.TabAction = dbgGridNavigation
        GridSize.ScrollBars = dbgNone
    End If
    Exit Sub
Err_SizeLoad:
    MisMsg "SizeLoad Error:" & Err.Description

End Sub

Public Function CheckStock(TGrid As TDBGrid, DGrid As MSDataGridLib.DataGrid, strStock As String) As Integer
    Dim rstlock As Recordset, i As Integer
    CheckStock = 0
    On Error GoTo Err_CheckStock
    
'    If isLockStock = True Then
        Set rstlock = New Recordset
        rstlock.Open "Select * From v_FreeStock Where Inventory_ID ='" & TGrid.Columns("Inventory_ID").Value & "' and ContactNum ='" & DLookUp("ContactNum", "Mis_Stock", "Description='" & strStock & "'") & "'", GetCNClient, adOpenForwardOnly
        If rstlock.EOF Then
            MisMsg "仓库中没有该产品！"
            Exit Function
        Else
            If rstlock![Qty] < TGrid.Columns("Qty").Value Then
                MisMsg "仓库数量不足。"
                Exit Function
            End If
                          
            If DGrid.Visible = True Then
                For i = 0 To DGrid.Columns.Count - 1
                'MsgBox Nz(rstLock.Fields(Me.GridSize.Columns(i).DataField), 0)
                    If Val(rstlock.Fields(DGrid.Columns(i).DataField)) < Val(IIf(DGrid.Columns(i).Value = "", 0, DGrid.Columns(i).Value)) Then
                        MisMsg "仓库中" & DGrid.Columns(i).Caption & "的数量不足。"
                        Exit Function
                    End If
                Next
            End If
        End If
        Set rstlock = Nothing
'    End If
    
    CheckStock = 1
    Exit Function
Err_CheckStock:
    CheckStock = 0
    MisMsg "CheckStock Error:" & Err.Description
    Exit Function
End Function
Public Function CheckupBill(TGrid As TDBGrid, DGrid As MSDataGridLib.DataGrid, strupBillNo As String) As Integer
Dim rstlock As Recordset, i As Integer
    CheckupBill = 0
    On Error GoTo Err_CheckupBill
        Set rstlock = New Recordset
        rstlock.Open "Select * From v_FreeupBill Where Inventory_ID ='" & TGrid.Columns("Inventory_ID").Value & "' and up_Evidence_Number ='" & strupBillNo & "'", GetCNClient, adOpenForwardOnly
        If rstlock.EOF Then
            MisMsg strupBillNo & "单据中没有该产品！"
            Exit Function
        Else
            If rstlock![Qty] < TGrid.Columns("Qty").Value Then
                MisMsg strupBillNo & "单据中数量不足。"
                Exit Function
            End If
                          
            If DGrid.Visible = True Then
                For i = 0 To DGrid.Columns.Count - 1
                
                    If Val(rstlock.Fields(DGrid.Columns(i).DataField)) < Val(IIf(DGrid.Columns(i).Value = "", 0, DGrid.Columns(i).Value)) Then
                        MisMsg strupBillNo & "单据中" & DGrid.Columns(i).DataField & "的数量不足。"
                        Exit Function
                    End If
                Next
            End If
        End If
        Set rstlock = Nothing
    CheckupBill = 1
    Exit Function
        
Err_CheckupBill:
    CheckupBill = 0
    MisMsg "CheckupBill Error:" & Err.Description
    Exit Function
End Function



Public Function GridSum(DGrid As MSDataGridLib.DataGrid) As Double
    Dim i As Integer
    GridSum = 0
    For i = 1 To DGrid.Columns.Count - 1