frmpurchasesalevoucher.frm

金算盘软件代码

        '采购、采购发票、直运采购、受托入库、受托结算
        strSql = strSql & "WHERE lngActivityTypeID  IN (" & atInPurchase & "," _
            & atInPurchaseInvoice & "," & atInDirectPurchase & "," & atInBorrow & "," _
            & atInBorrowSettlement & ")"
    Case "销售业务"
        '销售、销售发票、直运销售、委托代销、代销结算、分期发出、分期结算
        strSql = strSql & "WHERE (lngActivityTypeID  IN (" & atOutSale & "," _
            & atOutLend & "," & atOutStage & ")"
        If optInvoice(0).Value Then
            strSql = strSql & " AND blnIsInvoice=1 OR lngActivityTypeID IN (" _
                & atOutSaleInvoice & "," & atOutLendSettlement & "," & atOutStageSettlement _
                & "," & atOutDirectSale & ")) AND lngVoucherID=-1"
        Else
            strSql = strSql & ")) AND lngVoucherID=-1"
        End If
'        strSql = strSql & "WHERE (lngActivityTypeID  IN (" & atOutSale & "," _
'            & atOutDirectSale & "," & atOutLendSettlement & "," & atOutStageSettlement & ")"
'        strSql = strSql & " AND blnIsInvoice OR lngActivityTypeID=" & atOutSaleInvoice _
'            & " OR lngActivityTypeID=" & atOutLend & " OR lngActivityTypeID=" & atOutStage & ")"
    Case "委托加工"
        '加工处库、加工入库、加工费用
        strSql = strSql & "WHERE lngActivityTypeID  IN (" & atOutEntrust & "," _
            & atInEntrust & "," & atInEntrustExpense & ")"
    Case "商品调价"
        '商品调价、受托调价
        strSql = strSql & "WHERE lngActivityTypeID  IN (" & atInVentoryPrice & "," _
            & atBorrowPrice & ")"
    Case "盘点业务"
        '盘盈入库、盘亏出库
        strSql = strSql & "WHERE lngActivityTypeID  IN (" & atInStock & "," _
            & atOutStock & ") AND lngVoucherID=-1"
    Case "其他业务"
        '自制入库、其他入库、领用出库、其他出库、成本调整
        strSql = strSql & "WHERE lngActivityTypeID  IN (" & atInSelf & "," & atInAssemble & "," & atOutApart & "," & atOutAssemble & "," & atInApart & "," _
            & atInOther & "," & atOutSelf & "," & atOutOther & "," & atOutCostAdjust & ") AND lngVoucherID=-1"
        ReChoose
    Case "结转成本"
        '销售出库、委托出库、分期出库、加工出库、领用出库、其他出库、盘亏出库、成本调整、直运销售
        strSql = strSql & "WHERE lngActivityTypeID  IN (" & atOutSale & "," & atOutLend & "," _
            & atOutStage & "," & atOutEntrust & "," & atOutSelf & "," & atOutOther & "," _
            & atOutStock & "," & atOutCostAdjust & "," _
            & atInAssemble & "," & atOutApart & "," & atOutAssemble & "," & atInApart _
            & ") AND lngVoucherID1=-1 AND strDate<='" & mstrEndDate & "'"
        If chkInCome.Value = 1 Then
            strSql = strSql & " AND (lngActivityTypeID<>11 OR lngActivityTypeID=11 AND dblCurrInvoiceAmount<>0)"
        End If
        ReChoose
    Case "保险业务"
        strSql = strSql & "WHERE lngVoucherID=-1"
    End Select
    
    '指定排序方式
    If optManner(1).Value Then
        strSql = strSql & " ORDER BY lngCustomerID,strReceiptTypeName,lngActivityID"
    ElseIf optManner(2).Value Then
        strSql = strSql & " ORDER BY lngReceiptTypeID,lngActivityID"
    ElseIf optManner(3).Value Then
        strSql = strSql & " ORDER BY lngCustomerID,lngReceiptTypeID,lngActivityID"
    Else
        If cboActivityType.Text = "采购业务" Then
            strSql = strSql & " ORDER BY strReceiptTypeName,lngActivityID"
        Else
            strSql = strSql & " ORDER BY lngActivityID"
        End If
    End If
    
    Set recDetail = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recDetail.EOF Then
        
        prgGenVoucher.Max = 100
        prgGenVoucher.Visible = True
        
        '设置凭证模板
        InitVoucherModel
        '生成凭证（并保存）
        GenVoucher
        prgGenVoucher.Visible = False
        
        '显示结果提示
        If mintVoucherNum > 0 Then
            gclsSys.SendMessage Me.hwnd, msgReceipt41
            If VoucherData(0).ErrorString <> "" Then
                ShowMsg hwnd, "生成了" & mintVoucherNum & "张凭证，其中：" & Chr(13) & VoucherData(0).ErrorString, vbOKOnly + vbExclamation, Caption
            End If
'            ShowMsg hwnd, "生成了" & mintVoucherNum & "张凭证！", vbOKOnly + vbInformation, Caption
            If mlngVoucherID > 0 Then
                recDetail.Close
                Set recDetail = Nothing
                Unload Me
                BillPublic.ShowBill 50, mlngVoucherID
                Exit Sub
            End If
        Else
            If VoucherData(0).ErrorString <> "" Then
                ShowMsg hwnd, "凭证生成失败：" & Chr(13) & VoucherData(0).ErrorString, vbOKOnly + vbCritical, Caption
            Else
                ShowMsg hwnd, "没有凭证生成！", vbOKOnly + vbCritical, Caption
            End If
        End If
    Else
        ShowMsg hwnd, "没有数据生成凭证！", vbOKOnly + vbCritical, Caption
    End If
    recDetail.Close
    Set recDetail = Nothing
    Exit Sub
    
ErrHandle:
    errNo = Errors.ErrorsDeal(True, Me)
    Select Case errNo
    Case edtResume: Resume
    Case edtResumeNext: Resume Next
    Case edtCanNotKnown
        ShowMsg hwnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, Caption
    End Select
End Sub
Private Sub cmdStep_Click(Index As Integer)
    Dim blnUnload As Boolean
    Dim strMsg As String
    
    blnUnload = False
    
    Select Case Index
    Case 0  '取消
        blnUnload = True
    Case 1  '上一步
        If stabWizard.Tab > 0 Then
            stabWizard.Tab = stabWizard.Tab - 1
        End If
    Case 2  '下一步
        If stabWizard.Tab < mintStepNum Then
            stabWizard.Tab = stabWizard.Tab + 1
        End If
    Case 3: '完成
        If ValidStep(mintStepNum) Then
            cmdStep(3).Enabled = False
            Execute
            blnUnload = True
        End If
    End Select
    
    If blnUnload Then
       Unload Me
    End If
End Sub
'重设按扭显示属性
Private Sub RefreshCmd()
    Dim lngCnt As Long
    
    Select Case stabWizard.Tab
    Case 0
        cmdStep(1).Enabled = False
        cmdStep(2).Enabled = True
    Case mintStepNum
        cmdStep(1).Enabled = True
        cmdStep(2).Enabled = False
    Case Else
        cmdStep(1).Enabled = True
        cmdStep(2).Enabled = True
    End Select
    
    '是否每步都合法
    For lngCnt = 0 To mintStepNum
        If Not mblnValid(lngCnt) Then
            Exit For
        End If
    Next lngCnt
    cmdStep(3).Enabled = (lngCnt > mintStepNum)
    
    '若是最后一步，把完成按扭变为有效
    If Not cmdStep(3).Enabled Then
        If stabWizard.Tab = mintStepNum Then
            cmdStep(3).Enabled = True
        End If
    End If
    
    If stabWizard.Tab = stabWizard.Tabs - 1 Then
        On Error Resume Next
        cmdStep(3).SetFocus
    Else
        On Error Resume Next
        cmdStep(2).SetFocus
    End If
End Sub


''''''''''''''''''''''''''''''''
'
' 向导初始过程
'
''''''''''''''''''''''''''''''''
'初始业务类型
Private Sub InitActivity()
    Dim lngAccount1 As Long
    Dim lngAccount2 As Long
    
    cboActivityType.TabStop = True
    chkNoPurchase.TabStop = True
'    chkNoSame.TabStop = True
    optInvoice(0).TabStop = True
    optInvoice(1).TabStop = True
    msgReceipt.TabStop = False
    cmdReceipt(0).TabStop = False
    cmdReceipt(1).TabStop = False
    cmdReceipt(2).TabStop = False
    cmdReceipt(3).TabStop = False
    cmdReceipt(4).TabStop = False
    lstxtTemplate.TabStop = False
    lstxtType.TabStop = False
    txtRemark.TabStop = False
    lstRemark.TabStop = False
    cmdReceipt(5).TabStop = False
    cmdReceipt(6).TabStop = False
    optManner(0).TabStop = False
    optManner(1).TabStop = False
    optManner(2).TabStop = False
    optManner(3).TabStop = False
    
    If cboActivityType.Tag <> "已设置" Then
        cboActivityType.Tag = "已设置"
        
        If mstrManner = "应收应付" Or mstrManner = "财务业务" Or mstrManner = "" Then
            If IsCanDo(41, gclsBase.OperatorID) And IsCanDo(210, gclsBase.OperatorID) Then
                cboActivityType.AddItem "应收应付"
            ElseIf IsCanDo(41, gclsBase.OperatorID) Then
                cboActivityType.AddItem "应收"
            ElseIf IsCanDo(210, gclsBase.OperatorID) Then
                cboActivityType.AddItem "应付"
            End If
            If gVersionType = vtAccount Then
                If IsCanDo(41, gclsBase.OperatorID) Then
                    cboActivityType.AddItem "销售业务"
                End If
                If IsCanDo(210, gclsBase.OperatorID) Then
                    cboActivityType.AddItem "采购业务"
                End If
            End If
        End If
        If mstrManner = "应收" Then
            If IsCanDo(41, gclsBase.OperatorID) Then
                cboActivityType.AddItem "应收"
            End If
            If gVersionType = vtAccount Then
                If IsCanDo(210, gclsBase.OperatorID) Then
                    cboActivityType.AddItem "采购业务"
                End If
            End If
        End If
        If mstrManner = "应付" Then
            If IsCanDo(210, gclsBase.OperatorID) Then
                cboActivityType.AddItem "应付"
            End If
            If gVersionType = vtAccount Then
                If IsCanDo(41, gclsBase.OperatorID) Then
                    cboActivityType.AddItem "销售业务"
                End If
            End If
        End If
        
        If (mstrManner = "现金银行" Or mstrManner = "收款付款") Or mstrManner = "财务业务" Or mstrManner = "" Then
            If IsCanDo(48, gclsBase.OperatorID) Then
                cboActivityType.AddItem "收款付款"
            End If
        End If
        
        If mstrManner = "采购业务" Or mstrManner = "购销业务" Or mstrManner = "" Then
            If IsCanDo(66, gclsBase.OperatorID) Then
                cboActivityType.AddItem "采购业务"
                If gVersionType = vtAccount Then
                    chkNoPurchase.Value = 1
'                    chkNoSame.Value = 0
                Else
                    chkNoPurchase.Value = GetSet(1, "购销凭证", "票货同到不走采购科目", 1)
'                    chkNoSame.Value = GetSet(1, "购销凭证", "非票货同到走暂估入库", 0)
                    lngAccount1 = GetSet(1, "特殊科目", "暂估入库", 0)
                    lngAccount2 = GetSet(1, "特殊科目", "采购科目", 1)
                    If lngAccount1 = 0 Then
'                        chkNoSame.Value = 0
'                        chkNoSame.Enabled = False
                    Else
'                        chkNoSame.Enabled = True
                    End If
                End If
            End If
        End If
        
        If mstrManner = "销售业务" Or mstrManner = "购销业务" Or mstrManner = "" Then
            If IsCanDo(86, gclsBase.OperatorID) Then
                cboActivityType.AddItem "销售业务"
'                If GetSet(1, "购销凭证", "根据发票确定收入", True) Then
                    optInvoice(0).Value = True
'                Else
'                    optInvoice(1).Value = True
'                End If
            End If
        End If
        
        If mstrManner = "库存业务" Or mstrManner = "" Then
            If IsCanDo(223, gclsBase.OperatorID) Then
                If gVersionType <= 2 Then
                    If mstrManner = "" Then
                        cboActivityType.AddItem "委托加工"
                    End If
                End If
            End If
            If IsCanDo(113, gclsBase.OperatorID) Then
                If gVersionType <= 2 Then
                    cboActivityType.AddItem "商品调价"
                End If
                cboActivityType.AddItem "盘点业务"
                cboActivityType.AddItem "其他业务"
            End If
        End If
        
        If mstrManner = "委托加工" Th