frmfi_zzpzset.frm

一个用VB写的财务软件源码

                           Case "LFSW"
                                  RESULTSTR = "&&" & str(GetMyLFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "WB"))
                           Case "JFSW"
                                  RESULTSTR = "&&" & str(GetMyJFS(CStr(aryvArgu(1)), CStr(aryvArgu(2)), CStr(aryvArgu(3)), "WB"))
                    '-------------------------------------------------------------------
                    End Select
              Case "DFHJ", "JFHJ"
                   bFormulaErr = False
              Case Else
                   bFormulaErr = True
                   Exit Sub
       End Select
End Sub
    
Private Sub cmdHelp_Click()
       
       If mFg.row > 0 Then
            Select Case mFg.col
                   Case COL_SUMMARY
                       frmH_Summ.ubSelectStatus = True
                       frmH_Summ.usKmdm = mFg.TextMatrix(mFg.row, COL_SUBJECT)
                       frmH_Summ.Show 1, Me
                       If frmH_Summ.txtName <> "" Then
                             txtEdit.text = frmH_Summ.txtName
                       End If
                       txtEdit.SetFocus
                   Case COL_SUBJECT
                        Load frmUSU_KmHelp
                        With frmUSU_KmHelp
                            .Show 1, Me
                           If .SubjectCode <> "" Then
                               txtEdit.text = .SubjectCode
                            End If
                        End With
                        Unload frmUSU_KmHelp
                   Case COL_ITEM
                        Load frmUSU_HelpItem
                        With frmUSU_HelpItem
                            .Show 1, Me
                            If .Ok Then
                                txtEdit.text = .usCode
                            End If
                        End With
                        Unload frmUSU_HelpItem
                   Case COL_DEPARTMENT
                        Load frmUSU_HelpDepartment
                        With frmUSU_HelpDepartment
                            .Show 1, Me
                            If .Ok Then
                                txtEdit.text = .usCode
                            End If
                        End With
                        Unload frmUSU_HelpDepartment
                   Case COL_DIRECT
                        frmFI_UsuFX.sFX = ""
                        frmFI_UsuFX.Show 1
                        
                        If frmFI_UsuFX.sFX <> "" Then
                           txtEdit.text = frmFI_UsuFX.sFX
                           txtEdit.SetFocus
                        End If
                        
                   Case COL_FORMULA
                   
                   '公式向导
'－－－－－－－－－－－－－－－－－－－－－－－－－－－
                    Dim frmFS As frmFI_UsuZzFormulaGuid         '公式名称选择向导一
                    Dim sFormulaType As String
                    Dim sFormulaName As String
                    Dim frmFC1 As frmFI_UsuZzFormula            '公式设置（向导二）
                    Dim GotoStepPrev As Boolean
GotoPrevStep:
                    GotoStepPrev = False
                    Set frmFS = New frmFI_UsuZzFormulaGuid
                    With frmFS
                        .Show 1
                        If .Ok Then
                            sFormulaType = .usFormulaType
                            sFormulaName = .usFormulaName
                        End If
                    End With
                    Unload frmFS
                    
                    Select Case sFormulaName
                        Case "QC", "QM", "FS", "LFS", "JFS", "QCN", "QMN", "FSN", "LFSN", _
                              "JFSN", "QCW", "QMW", "FSW", "LFSW", "JFSW"
                            Set frmFC1 = New frmFI_UsuZzFormula
                            With frmFC1
                                .usFormulaName = sFormulaName
                                .uiFx = 0
                                .Show 1
                                GotoStepPrev = .GotoPrev
                                    If .Ok Then
                                        txtEdit.text = Mid$(txtEdit.text, 1, txtEdit.SelStart) & _
                                        .usFormula & Mid$(txtEdit.text, txtEdit.SelStart + 1)
                                    End If
                            End With
                            Unload frmFC1
                        Case "JFHJ", "DFHJ"
                            Set frmFC1 = New frmFI_UsuZzFormula
                            With frmFC1
                               .usFormulaName = sFormulaName
                                If sFormulaName = "JFHJ" Then
                                    .uiFx = 0
                                ElseIf sFormulaName = "DFHJ" Then
                                    .uiFx = 1
                                End If
                                .ubPZHJ = True
                                .txtKm.Enabled = False
                                .cmdKMHelp.Enabled = False
                                .txtBm.Enabled = False
                                .cmdBmHelp.Enabled = False
                                .txtXm.Enabled = False
                                .cmdXmHelp.Enabled = False
                                .cboFx.Enabled = False
                                .Show 1
                                GotoStepPrev = .GotoPrev
                                If .Ok Then
                                    txtEdit.text = Mid$(txtEdit.text, 1, txtEdit.SelStart) & _
                                    .usFormula & Mid$(txtEdit.text, txtEdit.SelStart + 1)
                                End If
                                    
                            End With
                            Unload frmFC1
                            
                    End Select
                    If GotoStepPrev Then GoTo GotoPrevStep
                    txtEdit.SetFocus
        End Select
        End If
       
End Sub

'用于 Cell 控件，
'将本软件提供的所有自定义函数添加到指定的 Cell 控件
Public Sub AddUserDefineFunction()
   Dim sTmp As String
   Dim lCount As Long
    
    With cLlzzpz

            sTmp = """伊康财务v6系列_ZW"" double QC ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QC ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期初余额"
            sTmp = sTmp & vbCrLf & "END_HELP"
            lCount = .DefineFunctions(sTmp)
            
            sTmp = """伊康财务v6系列_ZW""  double QM( string d1,string d2,string d3,string d4],string d5] ) "
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QM( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期末余额"
            sTmp = sTmp & vbCrLf & "END_HELP"
             lCount = .DefineFunctions(sTmp)
                                    
            sTmp = """伊康财务v6系列_ZW""  double FS (  string d1 ,string d2 ,string d3,string d4],string d5]  )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double FS ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "发生额"
            sTmp = sTmp & vbCrLf & "END_HELP"
            lCount = .DefineFunctions(sTmp)
                                    
            sTmp = """伊康财务v6系列_ZW""  double LFS( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double LFS( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "累计发生额"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            '-----------------------------------------------------------------------
            'ADD贷方合计，借方合计  卞 2002/04/12
            '--------------BEGIN----------------------------------------------------
            
            sTmp = """伊康财务v6系列_ZW""  double DFHJ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double DFHJ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "贷方合计"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            sTmp = """伊康财务v6系列_ZW""  double JFHJ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double JFHJ( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "借方合计"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            '--------------END--------------------------------------------------
                      
            sTmp = """伊康财务v6系列_ZW""  double JFS( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double JFS( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "净发生额"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

         '------------------------------------------------------------------------------
            sTmp = """伊康财务v6系列_ZW""  double QCN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QCN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期初数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            sTmp = """伊康财务v6系列_ZW""  double QMN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QMN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期末数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
                                    
            sTmp = """伊康财务v6系列_ZW""  double FSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double FSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "发生数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double LFSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double LFSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "累计发生数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double JFSN( string d1,string d2,string d3,string d4],string d5])"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double JFSN( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "净发生数量"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            sTmp = """伊康财务v6系列_ZW""  double QCW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QCW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期初外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp
            
            sTmp = """伊康财务v6系列_ZW""  double QMW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double QMW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "期末外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double FSW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double FSW(string d1,string d2,string d3,string d4],string d5])"
            sTmp = sTmp & vbCrLf & "发生外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double LFSW(  string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double LFSW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "累计发生外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

            sTmp = """伊康财务v6系列_ZW""  double JFSW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "BEGIN_HELP"
            sTmp = sTmp & vbCrLf & " double JFSW( string d1,string d2,string d3,string d4],string d5] )"
            sTmp = sTmp & vbCrLf & "净发生外币"
            sTmp = sTmp & vbCrLf & "END_HELP"
            .DefineFunctions sTmp

    End With
End Sub

Private Sub form_load()

'----------------------检查凭证种类是否设置
    Dim rstPZZL As ADODB.Recordset
    Set rstPZZL = New ADODB.Recordset
    rstPZZL.CursorLocation = adUseClient
   
    cLlzzpz.Visible = False
    cLlzzpz.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
    Set frmH_Summ = New frmIN_Summary
    Call AddUserDefineFunction
    Call InitMfg
    Call FillCbo
    bStartPrint = False
    cmdHelp.Visible = False
    txtEdit.Visible = False
 End Sub

Private Sub InitMfg()       '初始化

        Dim j As Integer
'        Cell1.Rows = 1
'        Cell1.Cols = 1
        cLlzzpz.SetRows 1, cLlzzpz.GetCurSheet
        cLlzzpz.SetCols 1, cLlzzpz.GetCurSheet
        lbPzlb.Caption = ""
        With mFg
        .Redraw = False
         .FormatString = " |<摘要|<科目|<项目|<部门|<方向|<金额公式"
         .TextMatrix(0, COL_SUMMARY) = "摘要"
         .TextMatrix(0, COL_SUBJECT) = "科目"
         .TextMatrix(0, COL_ITEM) = "项目"
         .TextMatrix(0, COL_DEPARTMENT) = "部门"
         .TextMatrix(0, COL_DIRECT) = "方向"
         .TextMatrix(0, COL_FORMULA) = "金额公式"
         .Rows = 1
         .Cols = 4 + 2 + 1
          .ColWidth(0) = 300
        .RowHeight(0) = 380             '设表头行高、列宽
        .ColWidth(COL_SUMMARY) = 2150                '摘要
        .ColWidth(COL_SUBJECT) = 2150
        If m_sPzType = "自定义" Then
            .ColWidth(COL_ITEM) = 2150