frmwizard.frm

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

Option Base 1

Const STEPS = 6     '向导的总步数

Dim m_iSubjFixedLevels As Integer       '当预置行业科目时，固定的级数


'=================================2002.9.5 yao revise=====================================
'Public bUpdate As Boolean
Private m_bUpdate As Boolean
Private cwdbcnn As New ADODB.Connection

Public Property Get bUpdate() As Boolean
 bUpdate = m_bUpdate
End Property

Public Property Let bUpdate(ByVal vNewValue As Boolean)
m_bUpdate = vNewValue
End Property
'========================================================================================

Private Sub Form_Load()
    Dim sSql As String, i As Long, j As Long
    Dim rstTemp As ADODB.Recordset
    If m_bUpdate = True Then lbPro.Visible = False
    '设置会计期间表格
    With mfgPeriod
        .Rows = 13
        .Cols = 3
        .FormatString = "期号|<起始日期|<截止日期"
        .ColAlignment(0) = 4
        .ColAlignment(1) = 4
        .ColAlignment(2) = 4
        .ColWidth(0) = 600
        .ColWidth(1) = 1200
        .ColWidth(2) = 1200
    End With
    
    '设置编码级次表格
    With mfgCodeLevel
        .FormatString = "编码项目|<最大级数|<最大长度|<实际长度|<第一级长度|<第二级长度|<" & _
                "第三级长度|<第四级长度|<第五级长度|<第六级长度|<第七级长度|<第八级长度"
        .Rows = 7
        .ColWidth(0) = 2110
        .RowHeight(0) = 1000
        For j = 1 To .Cols - 1
            .ColWidth(j) = 350
        Next j
        For j = 0 To .Cols - 1
            .ColAlignment(j) = 4
        Next j
        For i = 1 To .Rows - 1
            .RowHeight(i) = 350
        Next i
        .TextMatrix(3, 0) = "部门"          '5/12
        .TextMatrix(6, 0) = "供应商分类"      '5/12
        .TextMatrix(2, 0) = "结算方式"      '2/3
        .TextMatrix(1, 0) = "会计科目"      '8/40
        .TextMatrix(5, 0) = "客户分类"      '5/12
        .TextMatrix(4, 0) = "项目分类"    '8/40
        .TextMatrix(3, 1) = 5
        .TextMatrix(3, 2) = 12
        .TextMatrix(1, 1) = 8
        .TextMatrix(1, 2) = 40
        .TextMatrix(2, 1) = 2
        .TextMatrix(2, 2) = 3
        .TextMatrix(4, 1) = 8
        .TextMatrix(4, 2) = 40
        .TextMatrix(6, 1) = 5
        .TextMatrix(6, 2) = 12
        .TextMatrix(5, 1) = 5
        .TextMatrix(5, 2) = 12
        '部门预置22
        .TextMatrix(3, 3) = 4
        .TextMatrix(3, 4) = 2
        .TextMatrix(3, 5) = 2
        '科目预置，放在 cboTradeKind_Click 事件中
        '结算方式预置21
        .TextMatrix(2, 3) = 3
        .TextMatrix(2, 4) = 2
        .TextMatrix(2, 5) = 1
        '项目分类预置4563
        .TextMatrix(4, 3) = 6
        .TextMatrix(4, 4) = 2
        .TextMatrix(4, 5) = 2
        .TextMatrix(4, 6) = 2
        '客户分类预置432
        .TextMatrix(5, 3) = 6
        .TextMatrix(5, 4) = 2
        .TextMatrix(5, 5) = 2
        .TextMatrix(5, 6) = 2
        '供应商分类预置432
        .TextMatrix(6, 3) = 6
        .TextMatrix(6, 4) = 2
        .TextMatrix(6, 5) = 2
        .TextMatrix(6, 6) = 2
    End With
    
    '填入当前年度、月份
    txtBeginYear.text = Year(Format(Date, "yyyy-mm-dd"))
    txtBeginMonth.text = Month(Format(Date, "yyyy-mm-dd"))
    
    '装入行业性质
    sSql = "select * from tSYS_trade order by ID"
    Set rstTemp = New ADODB.Recordset
    With rstTemp
        .CursorLocation = adUseClient
        .Open sSql, gloSys.cnnSys, adOpenStatic, adLockReadOnly
        If .RecordCount > 0 Then
            .MoveFirst
            For i = 1 To .RecordCount
                cboTradeKind.AddItem .Fields("Name").Value
                cboTradeKind.ItemData(cboTradeKind.NewIndex) = .Fields("ID").Value
                .MoveNext
            Next i
        End If
        .Close
    End With
    cboTradeKind.ListIndex = 0
    
    '装入月末结算日
    cboMonthEnd.Clear
    For i = 21 To 31
        cboMonthEnd.AddItem CStr(i)
    Next i
    cboMonthEnd.ListIndex = cboMonthEnd.ListCount - 1
End Sub

Private Sub cmdNext_Click()
    Dim sSql As String
    Dim b As Boolean
    Dim rstTemp As ADODB.Recordset
    Dim i As Long, j As Long
    On Error Resume Next
    Select Case sTb.Tab
        Case 0
         
            '检查账套号
            If Not m_bUpdate Then
                If Trim$(txtAccountID.text) = "" Then
                    MsgBox "请输入由数字组成的账套号！", vbInformation
                    txtAccountID.SetFocus
                    Exit Sub
                ElseIf Len(Trim$(txtAccountID.text)) <> 4 Then
                    MsgBox "账套号必须为四位！", vbInformation
                    txtAccountID.SetFocus
                    Exit Sub
                Else
                    Set rstTemp = New ADODB.Recordset
                    sSql = "select count(*) from tSYS_account where accountID='" & txtAccountID.text & "'"
                    With rstTemp
                        .CursorLocation = adUseClient
                        .Open sSql, gloSys.cnnSys, adOpenStatic, adLockReadOnly
                        If Not (IsNull(.Fields(0).Value) Or .Fields(0).Value = 0) Then
                            MsgBox "该号码已经存在，请重新输入账套号！", vbInformation
                            txtAccountID.SelStart = 0
                            txtAccountID.SelLength = Len(txtAccountID.text)
                            txtAccountID.SetFocus
                            Exit Sub
                        End If
                        .Close
                    End With
'==========================================2002.9.5 yao add ========================================================
                    If IsExistUser(txtAccountID.text) Then
                        MsgBox "该号码已经存在，请重新输入账套号！", vbInformation, "提示"
                         txtAccountID.SelStart = 0
                         txtAccountID.SelLength = Len(txtAccountID.text)
                         txtAccountID.SetFocus
                         Exit Sub
                    End If
'====================================================================================================================
                End If
             End If
            '检查账套名称
            If Trim$(txtAccountName.text) = "" Then
                MsgBox "请输入账套名称！", vbInformation
                txtAccountName.SetFocus
                Exit Sub
            End If
            '检查账套启用年份
            If Trim$(txtBeginYear.text) = "" Then
                MsgBox "请输入账套的启用年份！", vbInformation
                txtBeginYear.SetFocus
                Exit Sub
            ElseIf val(txtBeginYear.text) < 1950 Or val(txtBeginYear.text) > 2050 Then
                MsgBox "请输入 1950 - 2050 之间的年份！", vbInformation
                txtBeginYear.SetFocus
                Exit Sub
            End If
            '检查账套启用月份
            If Trim$(txtBeginMonth.text) = "" Then
                MsgBox "请输入账套的启用月份！", vbInformation
                txtBeginMonth.SetFocus
                Exit Sub
            ElseIf val(txtBeginMonth.text) < 1 Or val(txtBeginMonth.text) > 12 Then
                MsgBox "请输入一个合法的月份！", vbInformation
                txtBeginMonth.SelStart = 0
                txtBeginMonth.SelLength = Len(txtBeginMonth.text)
                txtBeginMonth.SetFocus
                Exit Sub
            End If
            '检查账套主管
            If Trim$(txtMaster.text) = "" Then
                MsgBox "请输入账套主管的名称！", vbInformation
                txtMaster.SetFocus
                Exit Sub
            End If
            '检查本位币名称
            If Trim$(txtCurrency.text) = "" Then
                MsgBox "请输入本位币名称！", vbInformation
                txtCurrency.SetFocus
                Exit Sub
            End If
            '检查账套的科目代码是定长还是用分隔符进行分隔
            
'====================================2002.8.26=yao revise=====================================================
'            If Opt_Seperate.Value Then
               If Trim(txtSeperateChar.text) = "" Then
                  MsgBox "请输入科目代码分隔符！", vbInformation
                  txtSeperateChar.SetFocus
                  Exit Sub
               End If
'            End If
'============================================================================================================
        Case 1
            '检查单位名称
            If Trim$(txtEnterName.text) = "" Then
                MsgBox "请输入单位名称！", vbInformation
                txtEnterName.SetFocus
                Exit Sub
            End If
        Case 3
            With mfgCodeLevel
                If Me.bUpdate = True Then
                   If g_FLAT = "SQL" Then
                        cwdbcnn.Open GetConnectString(g_FLAT, gloSys.sServer, _
                        gloSys.sUser, s.decrypt(gloSys.sPassword), "cwdb" & Trim(txtAccountID.text))
                    Else
                        cwdbcnn.Open GetConnectString(g_FLAT, gloSys.sServer, _
                        "cwdb" & Trim(txtAccountID.text), "ykcwdb" & Trim(txtAccountID.text))
                    End If
                    Dim sTempType As String
                    Set rstTemp = New ADODB.Recordset
                    rstTemp.CursorLocation = adUseClient
                    rstTemp.Open "select * from tUSU_DmJS where type='供应' or type='客户' or type='项目' or type='部门' or type='结算' or  type='科目' ", cwdbcnn, adOpenStatic, adLockOptimistic
                    j = 0
                    Do Until rstTemp.EOF
                       sTempType = rstTemp.Fields("type")
                       i = 1
                       If rstTemp.EOF <> True Then
                            Do Until rstTemp.Fields("type") <> sTempType
                               Select Case rstTemp.Fields("type")
                                      Case "科目"
                                           j = 0
                                      Case "结算"
                                           j = 1
                                      Case "部门"
                                           j = 2
                                      Case "项目"
                                           j = 3
                                      Case "客户"
                                           j = 4
                                      Case "供应"
                                           j = 5
                               End Select
                               If rstTemp.Fields("ws") <> 0 Then
                                  mfgCodeLevel.TextMatrix(1 + j, i + 3) = rstTemp.Fields("ws")
                               Else
                                  mfgCodeLevel.TextMatrix(1 + j, i + 3) = ""
                               End If
                               rstTemp.MoveNext
                               If rstTemp.EOF Then Exit Do
                               i = i + 1
                            Loop
                       End If
                    Loop
                    rstTemp.Close
                End If
                cwdbcnn.Close
                For i = 1 To .Rows - 1
                    If val(.TextMatrix(i, 4)) = 0 Then
                        MsgBox "第一级编码长度不能为零！", vbInformation
                        .Row = i
                        .Col = 4
                        mfgCodeLevel.SetFocus
                        Exit Sub
                    End If
                    For j = 4 To .Cols - 2
                        If val(.TextMatrix(i, j)) = 0 And val(.TextMatrix(i, j + 1)) <> 0 Then
                            MsgBox "编码位数不能空开！", vbInformation
                            .Row = i
                            .Col = j
                            mfgCodeLevel.SetFocus
                            Exit Sub
                        End If
                    Next j
                    If val(.TextMatrix(i, 2)) < val(.TextMatrix(i, 3)) Then
                        MsgBox "超过最大长度！", vbInformation
                        .Row = i
                        .Col = 4
                        mfgCodeLevel.SetFocus
                        Exit Sub
                    End If
                Next i
            End With
    End Select
            
    sTb.Tab = sTb.Tab + 1
    If sTb.Tab = 1 Then cmdPrevious.Enabled = True
    If sTb.Tab = STEPS - 1 Then cmdNext.Enabled = False: cmdFinish.Enabled = True

    Call CaseTabFocus
    
End Sub

Private Sub cmdPrevious_Click()
    
    sTb.Tab = sTb.Tab - 1
    If sTb.Tab = 0 Then cmdPrevious.Enabled = False
    If sTb.Tab = STEPS - 2 Then cmdNext.Enabled = True: cmdFinish.Enabled = False
    Call CaseTabFocus
    
End Sub

Private Sub CaseTabFocus()
On Error Resume Next
    Select Case sTb.Tab
        Case 0
            txtAccountID.SetFocus
        Case 1