+

财务分析 财财务分析务分析

  Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  Bbbwhgs = 0                                          '报 表 表 尾 行 数
  ReDim Bbxbt(1 To Bbxbtgs)
  ReDim bbxbtzzxs(1 To Bbxbtgs)
  If Bbbwhgs <> 0 Then
     ReDim Bbbwh(1 To Bbbwhgs)
     ReDim Bbbwhzzxs(1 To Bbbwhgs)
  End If
  Bbzbt = ReportTitle
  Bbxbt(1) = " "
  bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  Call Scyxsjb(Me.CzxsGrid)                                '生成报表数据
  Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  If Not bbylte Then
     Unload DY_Tybbyldy
  End If
End Sub

'=======================列表视图程序结束=================================
























'=============单张视图程序代码开始============================

'Option Explicit
'Public bExpChange As Boolean  '如果确认公式所做的修改 则此值为True
'                              '否则为False
'Private Const ME_CAPTION = "公式选定"
'Private Const ME_CODE = "cwfx_Expressions"
'
'Private CodeListRs As New ADODB.Recordset


Private Sub cmdCancel_Click()
    Me.bExpChange = False
    StTab.Tab = 0
    StTab.TabEnabled(0) = True
    StTab.TabEnabled(1) = False
End Sub

Private Sub cmdOK_Click()
    If CheckExp = False Then
        'MsgBox "公式不合法！", vbCritical, "提示"
        Xtxxts "公式不合法！", 0, 1
        Exit Sub
    End If
    '返回解析后的公式（正向解析）
    Me.Tag = ExpTranslate(True, txtExp.Text)
    CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("003", GridStr(), Szzls)) = Me.Tag
    Me.bExpChange = True
    Call SaveData
    StTab.Tab = 0
    StTab.TabEnabled(0) = True
    StTab.TabEnabled(1) = False
   
End Sub

Private Sub cmdSel_Click()
    Call lstCodeList_DblClick '默认为相加
End Sub

Private Sub OldForm_Activate()
    With Me
        '公式文本框内容为解析后的公式 (反向解析)
        txtExp.Text = ExpTranslate(False, Me.Tag)
        .Tag = ""
        .labList.Caption = ""
        bExpChange = False
        '.Caption = ME_CAPTION
        txtExp.SetFocus
        txtExp.SelStart = 0
        txtExp.SelLength = Len(txtExp.Text)
    End With
End Sub

Private Sub OldForm_Load()
    
    Call FullCodeList ' 填充科目列表
    
End Sub
Private Sub OldForm_Unload(Cancel As Integer)
    On Error Resume Next
    CodeListRs.Close
    Set CodeListRs = Nothing
End Sub

Private Sub lstCodeList_Click()
    Dim strTem As String
    strTem = Right(LstCodeList.List(LstCodeList.ListIndex), Len(LstCodeList.List(LstCodeList.ListIndex)) - 20)
    labList.Caption = strTem
End Sub

Private Sub lstCodeList_DblClick()
    Dim strTem As String
    Dim iWhere As Integer '用于截取字符
    Dim strSign As String  '符号，+ 或 - 或 ""
    If LstCodeList.ListIndex = -1 Then Exit Sub
    iWhere = InStr(1, LstCodeList.List(LstCodeList.ListIndex), " ") - 1
    strTem = Left(LstCodeList.List(LstCodeList.ListIndex), iWhere)
    If Trim(txtExp.Text) = "" Then
        strSign = ""
    ElseIf OptAdd.Value = True Then
        strSign = "+"
    ElseIf OptAdd.Value = False Then
        strSign = "-"
    End If
    
    txtExp.Text = txtExp.Text & strSign & strTem
    txtExp.SelStart = Len(txtExp.Text)
End Sub

Private Sub lstCodeList_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call lstCodeList_DblClick
    End If
End Sub


Private Sub txtExp_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
        Case 13
            Call cmdOK_Click
    End Select
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
   Select Case Button.Key
      Case "ymsz"                                          '页面设置
          Dyymctbl.Show 1
      Case "yl"                                            '预 览
          Call bbyl(True)
      Case "dy"                                            '打 印
          Call bbyl(False)

      Case "xg"                                            '修 改
         Call Xgdqjl
        
      Case "sx"                                            '刷 新
       Call Cxnrtcwg
      Case "bz"                                            '帮 助
       Call F1bz
      Case "fh"                                            '退 出
       Unload Me
   End Select
End Sub
Private Sub Xgdqjl()
    With CzxsGrid
        iRow = .Row
        iCol = .Col
        If CzxsGrid.TextMatrix(iRow, Sydz("004", GridStr(), Szzls)) = "True" Then
        '如果此行可编辑 并且 双击行为写公式的行
            If Cxnrrec.State = adStateOpen Then Cxnrrec.Close
            Cxnrrec.Open "SELECT * FROM cwfx_BalanceInitial where ID='" & CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls)) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            Me.Tag = Cxnrrec!Account & ""
            Call OldForm_Activate
            StTab.Tab = 1
            StTab.TabEnabled(1) = True
            StTab.TabEnabled(0) = False
        End If
    End With
End Sub
'=================自定义程序开始====================================
Private Function CheckExp() As Boolean
    '公式检察，如果公式合法返加TRUE，否则返回FALSE
    Dim strTem As String
    Dim strTem2 As String
    Dim strTemLast As String
    Dim bOK As Boolean  '公式合法，则为True
    Dim i As Integer
    Dim j As Integer
    Dim codeColl As New Collection  '用于存放科目编码的集合
    Dim iLen As Integer
    Dim iWordBegin As Integer  '用于确定一个科目在字符串中的
    Dim iWordEnd As Integer    '开始位置和结束位置
    strTem = Trim(txtExp.Text)
    
    
    '去除字符串中的不合法字符
    Dim strLastWord As String
    For i = 1 To Len(strTem)
        strTem2 = Mid(strTem, i, 1)
        If strTem2 = "+" And strLastWord = "+" Then
            '不合法，去除此字符
        ElseIf strTem2 = "-" And strLastWord = "-" Then
            '不合法，去除此字符
        ElseIf strTem2 = " " Then
            '不合法，去除此字符
        ElseIf (Asc(strTem2) < Asc("0") Or Asc(strTem2) > Asc("9")) And (strTem2 <> "+" And strTem2 <> "-") Then
            '不合法，去除此字符
        Else
            strTemLast = strTemLast & strTem2
        End If
        strLastWord = strTem2
    Next
    '去除字符串右边多余的符号
    If Right(strTemLast, 1) = "+" Or Right(strTemLast, 1) = "-" Then
        strTemLast = Left(strTemLast, Len(strTemLast) - 1)
    End If
    '去除字符串左边多余的符号
    If Left(strTemLast, 1) = "+" Or Left(strTemLast, 1) = "-" Then
        strTemLast = Right(strTemLast, Len(strTemLast) - 1)
    End If
    txtExp.Text = strTemLast
    
    If strTemLast = "" Then  '如果公式为空
        CheckExp = True
        Exit Function
    End If
    
    
    '得到科目列表集合
    iLen = Len(strTemLast)
    iWordBegin = 1
    iWordEnd = 1
    For i = 1 To iLen
        
        strTem = Mid(strTemLast, i, 1)
        'iWordEnd = i - 1
        If strTem = "+" Or strTem = "-" Or i = iLen Then
            strTem = Mid(strTemLast, iWordBegin, i - iWordBegin + 1)
            strTem = IIf(Right(strTem, 1) = "+" Or Right(strTem, 1) = "-", Left(strTem, Len(strTem) - 1), strTem)
            codeColl.Add strTem
            iWordBegin = i + 1
        End If
    Next
    
    '验公式是否合法
    For i = 1 To codeColl.count
        bOK = False
        For j = 0 To LstCodeList.ListCount
            strTem2 = Trim(Left(LstCodeList.List(j), 20))
            Debug.Print codeColl.item(i)
            If codeColl.item(i) = strTem2 Then
                bOK = True
                Exit For
            End If
            
        Next
        If bOK = False Then
            CheckExp = bOK
            txtExp.SetFocus
            '----------------------------------------------------------
            '此处代码有待改进，
            'i的值为不合法的科目位置，如i=2则第二个科目不合法。
            '找出第(i-1)个符号与第i个符号之间的字符串，就为不合法字符串
            '“符号”指“+”或“-”
            txtExp.SelStart = InStr(1, strTemLast, codeColl.item(i)) - 1
            txtExp.SelLength = Len(codeColl.item(i))
            '---------------------------------------------------
            Exit Function
        End If
    Next
    CheckExp = bOK
End Function

Private Sub FullCodeList()
    Dim strSql As String
    Dim strCodeList As String
    strSql = "SELECT cCode,cClass,cName,EndFlag,cGrade FROM Cwzz_AccCode ORDER BY cCode"
    Set CodeListRs = Cw_DataEnvi.DataConnect.Execute(strSql)
    LstCodeList.Clear
    '格式化字符串
    With CodeListRs
        Do Until .EOF
            strCodeList = Trim(CodeListRs!cCode)
            strCodeList = strCodeList & Space(20 - Len(strCodeList))
            strCodeList = strCodeList & Trim(CodeListRs!cName)
            LstCodeList.AddItem strCodeList
            .MoveNext
        Loop
    End With
End Sub
Private Function ExpTranslate(ByVal bWay As Boolean, ByVal strExp As String) As String
    '公式解析过程序，参数bWay为TRUE则为正向解析，由科目代码->文字
    '                          FALSE 为反向解析，由文字->科目代码
    'strExp 为传递的公式字符串
    
    
    ExpTranslate = strExp
End Function
'=================自定义程序结束====================================

'=============单张视图程序代码结束============================