+

VB开发的ERP系统

        .Update
    End With
    
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
    Select Case Button.Key
    Case "bcgs"                              '保存表格格式
        Call Bcwggs(CzxsGrid, GridCode, GridStr())
    Case "hfmrgs"                            '恢复默认格式
        Call Hfmrgs(CzxsGrid, GridCode, GridStr())
    End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Cxnrrec.State <> adStateClosed Then Cxnrrec.Close
    Set Cxnrrec = Nothing
    Set frmExp = Nothing
    '---------原公式窗体Form_Unload--------------
    Call OldForm_Unload(Cancel)
    '-----------------------
End Sub

Private Sub CzxsGrid_DblClick()
    Call Xgdqjl
End Sub

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    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
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
        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
        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()
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
        cmdOK.Enabled = False
    End If

    
    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)
        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,codelevel 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