wizard.frm

金算盘软件代码

        On Error GoTo errhandle2
        MkDir strPath
        NewPathIsRight = True
        Exit Function
    End If
    If lngTmp = vbCancel Then
        NewPathIsRight = False
        stbBuildNewAcnt.Tab = 0
        txtFileName.SetFocus
        Exit Function
    End If
errhandle2:
    ShowMsg Me.hwnd, "新建路径不成功！", vbInformation, Me.Caption
    stbBuildNewAcnt.Tab = 0
    txtFileName.SetFocus
    NewPathIsRight = False
End Function
Private Sub cmdAcntSaveAs_Click()
    On Error GoTo ErrHandle
    With cdlgCommonDialog
        .Flags = cdlOFNOverwritePrompt + cdlOFNLongNames + cdlOFNCreatePrompt + cdlOFNHideReadOnly
        .DialogTitle = "保存帐套"
        .Filter = "帐套文件 (*.gdb)|*.gdb"
        .FileName = txtFileName.Text
        .ShowSave
        SendKeys "{HOME}+{END}"
        mstrFilepath = .FileName
        If mstrFilepath <> "" Then txtFileName.Text = .FileName
    End With
    Exit Sub
ErrHandle:
    If Err.Number = 20477 Then
        ShowMsg hwnd, "文件名称不正确，请重新输入。", vbInformation, Caption
        txtFileName.SetFocus
        txtFileName.SelStart = 0
        txtFileName.SelLength = Len(txtFileName.Text)
    Else
        ShowMsg hwnd, "文件路径或文件名称不正确，请重新输入。", vbInformation, Caption
        txtFileName.SetFocus
        txtFileName.SelStart = 0
        txtFileName.SelLength = Len(txtFileName.Text)
    End If
End Sub

Private Sub dteAffix_Change()
    mblnSDateIsChange = False
End Sub

Private Sub dteAffix_Error(bCancel As Integer)
    dteAffix.Text = msgPeriod.TextMatrix(mintMsgORow, mintMsgOCol)
    bCancel = 1
End Sub

Private Sub dteAffix_KeyUp(KeyCode As Integer, Shift As Integer, bCancel As Long)
    If KeyCode = vbKeyReturn Then
        msgPeriod.SetFocus ' dteAffix_LostFocus
    ElseIf KeyCode = vbKeySpace Then
        dteAffix.DropDownPanel
    End If
End Sub

Private Sub dteAffix_LostFocus()
    Dim blnIsEndDay As Boolean, i As Integer, iStartRow As Integer, dtmX As Date
    Dim strMonthEndDay As String, strDay As String, strDate As String
    
    On Error Resume Next
    If msgPeriod.TextMatrix(mintMsgORow, mintMsgOCol) <> dteAffix.Text Then
        If mintMsgOCol = 3 Then
            If mintMsgORow = mintPeriods Then
                If Format(dteAffix.Text, "yyyy-mm-dd") <= Format(dteStartDate(1).Text, "yyyy-mm-dd") Then
                    ShowMsg Me.hwnd, "帐套结束日期不能小于或等于帐套起始日期!", vbExclamation, Caption
                    mblnDateOK = False
                    stbBuildNewAcnt.Tab = 4
                    dteAffix.SetFocus
                    On Error GoTo 0
                    Exit Sub
                End If
                If DateDiff("d", CDate(msgPeriod.TextMatrix(1, 2)), CDate(dteAffix.Text)) <= 12 Then
                    ShowMsg Me.hwnd, "日期非法!", vbExclamation, Caption
                    mblnDateOK = False
                    stbBuildNewAcnt.Tab = 4
                    dteAffix.SetFocus
                    On Error GoTo 0
                    Exit Sub
                End If
                msgPeriod.TextMatrix(mintMsgORow, mintMsgOCol) = Format(dteAffix.Text, "yyyy-mm-dd")
                dteStartDate(2).Text = Format(dteAffix.Text, "yyyy-mm-dd")
                msgPeriod.TextMatrix(mintMsgORow, mintMsgOCol) = dteAffix.Text
                dteAffix.Visible = False
            End If
            If Format(dteAffix.Text, "yyyy-mm-dd") <= Format(msgPeriod.TextMatrix(mintMsgORow, 2), "yyyy-mm-dd") Then
                ShowMsg Me.hwnd, "结束日期不能小于或等于开始日期!", vbExclamation, Caption
                mblnDateOK = False
                stbBuildNewAcnt.Tab = 4
                dteAffix.SetFocus
                On Error GoTo 0
                Exit Sub
            End If
'            If mintMsgORow < mintPeriods Then
'                If Format(dteAffix.Text, "yyyy-mm-dd") >= Format(msgPeriod.TextMatrix(mintMsgORow + 1, 3), "yyyy-mm-dd") Then
'                    ShowMsg Me.hwnd, "日期非法!", vbExclamation, Caption
'                    mblnDateOK = False
'                    stbBuildNewAcnt.Tab = 4
'                    dteAffix.SetFocus
'                    On Error GoTo 0
'                    Exit Sub
'                End If
'            End If
            If mintMsgORow > 2 Then
                If Format(dteAffix.Text, "yyyy-mm-dd") <= Format(msgPeriod.TextMatrix(mintMsgORow - 1, 3), "yyyy-mm-dd") Then
                    ShowMsg Me.hwnd, "日期非法!", vbExclamation, Caption
                    mblnDateOK = False
                    stbBuildNewAcnt.Tab = 4
                    dteAffix.SetFocus
                    On Error GoTo 0
                    Exit Sub
                End If
            End If
            If mintMsgORow < mintPeriods Then
                msgPeriod.TextMatrix(mintMsgORow + 1, 2) = Format(dteAffix.Value + 1, "yyyy-mm-dd")
            End If
        End If
        If mintMsgOCol = 2 Then
            If mintMsgORow = 1 Then
                If Format(dteAffix.Text, "yyyy-mm-dd") >= Format(dteStartDate(2).Text, "yyyy-mm-dd") Then
                    ShowMsg Me.hwnd, "帐套起始日期不能大于或等于帐套结束日期!", vbExclamation, Caption
                    mblnDateOK = False
                    stbBuildNewAcnt.Tab = 4
                    dteAffix.SetFocus
                    On Error GoTo 0
                    Exit Sub
                End If
                If DateDiff("d", CDate(dteAffix.Text), CDate(msgPeriod.TextMatrix(mintPeriods, 3))) <= 12 Then
                    ShowMsg Me.hwnd, "日期非法!", vbExclamation, Caption
                    mblnDateOK = False
                    stbBuildNewAcnt.Tab = 4
                    dteAffix.SetFocus
                    On Error GoTo 0
                    Exit Sub
                End If
                msgPeriod.TextMatrix(mintMsgORow, mintMsgOCol) = Format(dteAffix.Text, "yyyy-mm-dd")
                dteStartDate(1).Text = Format(dteAffix.Text, "yyyy-mm-dd")
                msgPeriod.TextMatrix(mintMsgORow, mintMsgOCol) = dteAffix.Text
                dteAffix.Visible = False
            End If
            If Format(dteAffix.Text, "yyyy-mm-dd") >= Format(msgPeriod.TextMatrix(mintMsgORow, 3), "yyyy-mm-dd") Then
                ShowMsg Me.hwnd, "开始日期不能大于或等于结束日期!", vbExclamation, Caption
                mblnDateOK = False
                stbBuildNewAcnt.Tab = 4
                dteAffix.SetFocus
                On Error GoTo 0
                Exit Sub
            End If
            If mintMsgORow > 2 Then
                If Format(dteAffix.Text, "yyyy-mm-dd") <= Format(msgPeriod.TextMatrix(mintMsgORow - 1, 2), "yyyy-mm-dd") Then
                    ShowMsg Me.hwnd, "日期非法!", vbExclamation, Caption
                    mblnDateOK = False
                    stbBuildNewAcnt.Tab = 4
                    dteAffix.SetFocus
                    On Error GoTo 0
                    Exit Sub
                End If
            End If
            If mintMsgORow <> mintPeriods Then
                If Format(dteAffix.Text, "yyyy-mm-dd") >= Format(msgPeriod.TextMatrix(mintMsgORow + 1, 2), "yyyy-mm-dd") Then
                    ShowMsg Me.hwnd, "日期非法!", vbExclamation, Caption
                    mblnDateOK = False
                    stbBuildNewAcnt.Tab = 4
                    dteAffix.SetFocus
                    On Error GoTo 0
                    Exit Sub
                End If
            End If
            If mintMsgORow > 1 Then
                msgPeriod.TextMatrix(mintMsgORow - 1, 3) = Format(dteAffix.Value - 1, "yyyy-mm-dd")
            End If
        End If
        msgPeriod.TextMatrix(mintMsgORow, mintMsgOCol) = dteAffix.Text
        mintMsgORow = mintMsgORow + 1
        RefreshPeriod False
'        If mintPeriods = 12 And DateDiff("m", dteStartDate(1).Value, dteStartDate(2).Value) = 11 Then
'            If mintMsgOCol = 2 Then
'                If mintMsgORow > 1 Then
'                    iStartRow = mintMsgORow - 1
'                Else
'                    iStartRow = mintMsgORow
'                End If
'            Else
'                iStartRow = mintMsgORow
'            End If
'            If mintMsgORow = 1 And mintMsgOCol = 2 Then
'                msgPeriod.TextMatrix(1, 3) = Format(DateAdd("m", 1, CDate(msgPeriod.TextMatrix(1, 2)) - 1), "yyyy-mm-dd")
'            End If
'            blnIsEndDay = (GetMonthEndDay(msgPeriod.TextMatrix(iStartRow, 3)) = _
'                msgPeriod.TextMatrix(iStartRow, 3))
'            strDay = Right(msgPeriod.TextMatrix(iStartRow, 3), 2)
'            For i = iStartRow + 1 To mintPeriods
'                dtmX = CDate(msgPeriod.TextMatrix(i - 1, 3))
'                msgPeriod.TextMatrix(i, 2) = Format(dtmX + 1, "YYYY-MM-DD")
'                strMonthEndDay = GetMonthEndDay(Format(DateAdd("M", 1, dtmX), "YYYY-MM-DD"))
'                If blnIsEndDay Then
'                    msgPeriod.TextMatrix(i, 3) = strMonthEndDay
'                Else
'                    strDate = Left(Format(DateAdd("M", 1, dtmX), "YYYY-MM-DD"), 8) & strDay
'                    If strMonthEndDay < strDate Then
'                        msgPeriod.TextMatrix(i, 3) = strMonthEndDay
'                    Else
'                        msgPeriod.TextMatrix(i, 3) = strDate
'                    End If
'                End If
'            Next i
'            msgPeriod.TextMatrix(i - 1, 3) = dteStartDate(2).Text
'        End If
    End If
'    mblnDateOK = True
    dteAffix.Visible = False
End Sub

Private Sub dteStartDate_Change(Index As Integer)
'    Dim dtmBegin As Date, dtmEnd As Date, dtmStart As Date
'
'    On Error GoTo ErrHandle
'    If mblnIsInit Then Exit Sub
'    If Trim(Format(dteStartDate(Index).Text, "@;;")) = "" Then
'        If Not mblnBaseDateErr Then
'            If Index = 0 Then
'                ShowMsg hwnd, "帐套启用日期不能为空！", vbExclamation, Caption
'            ElseIf Index = 1 Then
'                ShowMsg hwnd, "起始日期不能为空！", vbExclamation, Caption
'            Else
'                ShowMsg hwnd, "结束日期不能为空！", vbExclamation, Caption
'            End If
'        End If
'        dteStartDate(Index).Text = mdtmDate(Index)
'        mblnBaseDateErr = True
'        Exit Sub
'    End If
'    dtmStart = CDate(dteStartDate(0).Text)
'    dtmBegin = CDate(dteStartDate(1).Text)
'    dtmEnd = CDate(dteStartDate(2).Text)
'    If dtmStart < dtmBegin Then
'        dteStartDate(Index).Text = mdtmDate(Index)
'        ShowMsg hwnd, "帐套启用日期不能小于帐套起始日期!", vbExclamation, Caption
'        mblnDateOK = False
'        stbBuildNewAcnt.Tab = 4
'        Exit Sub
'    End If
'    If dtmStart > dtmEnd Then
'        dteStartDate(Index).Text = mdtmDate(Index)
'        ShowMsg hwnd, "帐套启用日期不能大于帐套结束日期!", vbExclamation, Caption
'        mblnDateOK = False
'        stbBuildNewAcnt.Tab = 4
'        Exit Sub
'    End If
'    If dtmEnd - dtmBegin < mintPeriods Then
'        dteStartDate(Index).Text = mdtmDate(Index)
'        ShowMsg hwnd, "会计年度设置非法!", vbExclamation, Caption
'        mblnDateOK = False
'        stbBuildNewAcnt.Tab = 4
'        Exit Sub
'    End If
'    lblYear.Caption = StringOut(dteStartDate(0).Text, "-")
'    mblnBaseDateErr = False
'    If Index = 1 Then
'        msgPeriod.TextMatrix(1, 2) = Format(dtmBegin, "yyyy-mm-dd")
'    End If
'    If Index <> 0 Then RefreshPeriod
'    mblnDateOK = True
'    Exit Sub
'ErrHandle:
'    If Index = 0 Then
'        ShowMsg hwnd, "启用日期非法!", vbExclamation, Caption
'        dteStartDate(0).Text = mdtmDate(0)
'        mblnDateOK = False
'    ElseIf Index = 1 Then
'        ShowMsg hwnd, "起始日期非法!", vbExclamation, Caption
'        dteStartDate(1).Text = mdtmDate(1)
'        mblnDateOK = False
'        RefreshPeriod
'    Else
'        ShowMsg hwnd, "结束日期非法!", vbExclamation, Caption
'        dteStartDate(2).Text = mdtmDate(2)
'        mblnDateOK = False
'        RefreshPeriod
'    End If
'    stbBuildNewAcnt.Tab = 4
'    mblnSDateIsChange = True
End Sub

Private Sub dteStartDate_Error(Index As Integer, bCancel As Integer)
    bCancel = True
End Sub

Private Sub dteStartDate_GotFocus(Index As Integer)
    mdtmDate(Index) = dteStartDate(Index).Text
    If Index = 1 Then
'        stbBuildNewAcnt.Tab = 4
'        stbBuildNewAcnt_Click 4
    End If
End Sub

Private Sub dteStartDate_KeyPress(Index As Integer, KeyAscii As Integer, bCancel As Long)
    If KeyAscii = vbKeySpace Then
        dteStartDate(Index).DropDownPanel
    ElseIf KeyAscii = vbKeyReturn Then
        SendKeys "{TAB}"
    End If
End Sub

Private Sub dteStartDate_LostFocus(Index As Integer)
    Dim i As Integer
    Dim dtmBegin As Date, dtmEnd As Date, dtmStart As Date
    
    On Error GoTo ErrHandle
    If mblnIsInit Then Exit Sub
    If Trim(Format(dteStartDate(Index).Text, "@;;")) = "" Then
        If Not mblnBaseDateErr Then
            If Index = 0 Then
                ShowMsg hwnd, "帐套启用日期不能为空！", vbExclamation, Caption
            ElseIf Index = 1 Then
                ShowMsg hwnd, "起始日期不能为空！", vbExclamation, Caption
            Else
                ShowMsg hwnd, "结束日期不能为空！", vbExclamation, Caption
            End If
        End If
        dteStartDate(Index).Text = mdtmDate(Index)
        mblnBaseDateErr = True
        Exit Sub
    End If
    dtmStart = CDate(dteStartDate(0).Text)
    dtmBegin = CDate(dteStartDate(1).Text)
    dtmEnd = CDate(dteStartDate(2).Text)
    If dtmStart < dtmBegin Then
        dteStartDate(Index).Text = mdtmDate(Index)
        ShowMsg hwnd, "帐套启用日期不能小于帐套起始