frmbillno.frm

金算盘软件代码

        recNo.Close
End Sub
Private Sub ReCode()
    On Error GoTo EndProc
    Dim recSql As rdoResultset
    Dim str As String
    Dim strReceiptNo1 As String
    Dim lngReceiptNO1 As Long
    stbButton.Panels(1).Text = "编号整理"
     gclsBase.BaseWorkSpace.BeginTrans
     lngZds = 0: lngQhs = 0: lngZfs = 0
    If blnDate = False Then
        str = "intYear=" & Year1 & " and  bytPeriod=" & Month1 & " and  lngReceiptTypeID=" & lngReceiptTypeID1 & " order by strReceiptNO"
    Else
        str = "lngReceiptTypeID=" & lngReceiptTypeID1 & " ORDER BY strReceiptNO"
    End If
     Set recSql = gclsBase.BaseDB.OpenResultset("SELECT strReceiptNo,lngReceiptNo FROM receiptMaxNO WHERE " & str, rdOpenStatic)
     If recSql Is Nothing Then
         Exit Sub
     End If
     If recSql.EOF Then
         recSql.Close
         Set recSql = Nothing
         Exit Sub
     End If
     With recSql
     .MoveFirst
     '取前缀,最大编号
     Do While Not .EOF
        If IsNull(!strReceiptNo) Then
            strReceiptNo1 = ""
        Else
            strReceiptNo1 = !strReceiptNo
            strReceiptNo1 = Trim(strReceiptNo1)
        End If
        lngReceiptNO1 = !lngReceiptNo
        ReCode1 strReceiptNo1, lngReceiptNO1, lngReceiptTypeID1  '前缀，最大编号，单据类型
        .MoveNext
     Loop
     
     End With
     recSql.Close
     gclsBase.BaseWorkSpace.CommitTrans
     Set recSql = Nothing
     
'    stbButton.Panels(2).Text = "结束"
    SqlRecMaxNo
    On Error Resume Next
    gclsSys.SendMessage Me.hWnd, 30 + lngReceiptTypeID1
    Exit Sub
EndProc:
    Set recSql = Nothing
    gclsBase.BaseWorkSpace.RollBacktrans
    
End Sub

'前缀,最大编号,单据类型ID
Private Sub ReCode1(strAlp1 As String, strDig1 As Long, lngRTID As Long)
     Dim recNo As rdoResultset
     Dim str1 As String
     Dim i As Integer
     Dim strfg1 As String
     Dim blnQu As Boolean
     Dim lngLastNo As Long
     Dim strTableName As String
     Dim strSql As String
    If strAlp1 = "" Then strAlp1 = " "
        If lngRTID = 1 Then '采购订单
            str1 = "SELECT lngReceiptNO,lngPurchaseOrderID FROM PurchaseOrder WHERE strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
            strTableName = "PurchaseOrder"
        ElseIf lngRTID = 12 Then '销售订单
            str1 = "SELECT lngReceiptNO,lngSaleOrderID FROM SaleOrder WHERE strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
            strTableName = "SaleOrder"
        ElseIf lngRTID = 32 Then '入库成本
            str1 = "SELECT lngReceiptNO,lngCostPriceID FROM CostPrice WHERE strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
            strTableName = "CostPrice"
        ElseIf lngRTID = 33 Then '商品盘点
            str1 = "SELECT lngReceiptNO,lngStockTakingID FROM StockTaking WHERE strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
            strTableName = "StockTaking"
        ElseIf lngRTID >= 34 And lngRTID <= 40 Then '业务
            str1 = "SELECT lngReceiptNO,blnIsPrinted,strOldReceiptNo,lngActivityID FROM Activity WHERE lngReceiptTypeID=" & lngRTID & " and strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
            strTableName = "Activity"
        ElseIf lngRTID = 42 Or lngRTID = 43 Or lngRTID = 44 Or lngRTID = 45 Or lngRTID = 46 Or lngRTID = 47 Or lngRTID = 52 Then
            str1 = "SELECT lngReceiptNO,blnIsPrinted,strOldReceiptNo,lngActivityID FROM ItemActivity WHERE lngReceiptTypeID=" & lngRTID & " and strReceiptNO='" & strAlp1 & "'" & " ORDER BY lngReceiptNO"
            strTableName = "ItemActivity"
        ElseIf lngRTID >= 57 And lngRTID <= 63 Then
            str1 = "SELECT lngReceiptNO,lngActivityID FROM " & TableName(lngRTID) & " WHERE " & " strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
            strTableName = TableName(lngRTID)
        Else '商品业务
            str1 = "SELECT lngReceiptNO,blnIsPrinted,strOldReceiptNo,lngActivityID FROM ItemActivity WHERE lngReceiptTypeID=" & lngRTID & " and strReceiptNO='" & strAlp1 & "'" & " and strDate>='" & Format(sDate, "yyyy-mm-dd") & "' and strDate<='" & Format(eDate, "yyyy-mm-dd") & "'" & " ORDER BY lngReceiptNO"
            strTableName = "ItemActivity"
        End If
        Set recNo = gclsBase.BaseDB.OpenResultset(str1, rdOpenDynamic, rdConcurValues)
        
        With recNo
        For i = 1 To CInt(strDig1)
            If i \ 300 = i / 300 Then stbButton.Panels(2).Text = strAlp1 & Format$(i, "0000")
ReJustice:
            If recNo.EOF Then
                GoTo EndPoint
            ElseIf recNo(0) < i Then
                recNo.MoveNext
                GoTo ReJustice
            ElseIf recNo(0) = i Then
                blnQu = False
            ElseIf recNo(0) > i Then
'                lngLastNo = recNo(0)
'                recNo.Edit
'                    If recNo.rdoColumns.Count > 1 Then
'                        If recNo("blnIsPrinted") = 1 Then
'                            recNo("strOldReceiptNo") = SubStr(Trim(IIf(IsNull(recNo("strOldReceiptNo")), "", recNo("strOldReceiptNo")) & strAlp1 & Format$(recNo(0), "0000")) & " ", 1, 30)
'                        End If
'                    End If
'                    recNo(0) = i
'                recNo.Update
'                If lngRTID = 26 Or lngRTID = 28 Or lngRTID = 30 Or lngRTID = 31 Then
'                    '代销调拨、商品调拨、组装、撤卸
'                    recNo.MoveNext
'                    If recNo(0) = lngLastNo Then
'                        recNo.Edit
'                            If recNo("blnIsPrinted") = True Then
'                                recNo("strOldReceiptNo") = SubStr(Trim(recNo("strOldReceiptNo") & strAlp1 & Format$(recNo("intVoucherNO"), "0000")) & " ", 1, 30)
'                            End If
'                            recNo(0) = i
'                        recNo.Update
'                    End If
'                End If
                lngLastNo = recNo(0)
               strSql = "UPDATE " & strTableName & " SET " & recNo(0).Name & "=" & i
                    If recNo.rdoColumns.Count > 2 Then
                        If recNo("blnIsPrinted") = 1 Then
                            strSql = strSql & ",strOldReceiptNo='" & SubStr(Trim(IIf(IsNull(recNo("strOldReceiptNo")), "", recNo("strOldReceiptNo")) & strAlp1 & Format$(recNo(0), "0000")) & " ", 1, 30) & "'"
                        End If
                    End If
                strSql = strSql & " WHERE " & recNo(recNo.rdoColumns.Count - 1).Name & "=" & recNo(recNo.rdoColumns.Count - 1)
                gclsBase.BaseDB.Execute strSql, rdExecDirect
                recNo.MoveNext
                
                If lngRTID = 26 Or lngRTID = 28 Or lngRTID = 30 Or lngRTID = 31 Then
                    '代销调拨、商品调拨、组装、撤卸
                    If recNo(0) = lngLastNo Then
                        strSql = "UPDATE " & strTableName & " SET " & recNo(0).Name & "=" & i
                             If recNo.rdoColumns.Count > 2 Then
                                 If recNo("blnIsPrinted") = 1 Then
                                     strSql = strSql & ",strOldReceiptNo='" & SubStr(Trim(IIf(IsNull(recNo("strOldReceiptNo")), "", recNo("strOldReceiptNo")) & strAlp1 & Format$(recNo(0), "0000")) & " ", 1, 30) & "'"
                                 End If
                             End If
                         strSql = strSql & " WHERE " & recNo(recNo.rdoColumns.Count - 1).Name & "=" & recNo(recNo.rdoColumns.Count - 1)
                        gclsBase.BaseDB.Execute strSql, rdExecDirect
                        recNo.MoveNext
                    End If
                End If
            End If
        Next i
        End With
EndPoint:
        recNo.Close
        Set recNo = Nothing
        BillPublic.blnMaxNODecrease Year1, Month1, lngRTID, strAlp1, strDig1
End Sub

Private Sub spinMonth_Change()
    Month1 = spinMonth.Value
If blnDate = False Then
    If Month1 < gclsBase.PeriodOfDate(dtmStartDate) Or Month1 > gclsBase.PeriodOfDate(dtmEndDate) Then
        ShowMsg Me.hWnd, "期间已在当前帐套的开始时间和结束时间之外了！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
        spinMonth.Text = Format(gclsBase.PeriodOfDate(dtmStartDate), "0#")
'        Exit Sub
    End If
End If
    If bz = True Then
        bz = False
        GoTo endpiont
    End If
    sDate = 0
    eDate = 0
    Call gclsBase.DateOfPeriod(Year1, Month1, sDate, eDate)
    SqlRecMaxNo
endpiont:

End Sub

Private Sub spinMonth_KeyUp(KeyCode As Integer, Shift As Integer, bCancel As Long)
    If KeyCode = 13 Then
        Lstcha.SetFocus
    ElseIf KeyCode = vbKeyEscape Then
        Unload Me
    End If
End Sub

Private Sub spinYear_Change()
    Year1 = spinYear.Value
If blnDate = False Then
    '-------------------------------------------
    '设置控件的最大值和初始化其TEXT内容
        Call GetBaseStartAndEndPeriod(Year1, dtmStartDate, dtmEndDate, PeriodNum)
        spinMonth.Max = PeriodNum '+ gclsBase.PeriodOfDate(dtmStartDate) - 1
        spinMonth.Min = gclsBase.PeriodOfDate(dtmStartDate)
        If C2lng(spinMonth.Text) < C2lng(spinMonth.Min) Then
            spinMonth.Text = spinMonth.Min
        End If
    '-------------------------------------------
        If Year1 < gclsBase.FYearOfDate(dtmStartDate) Or Year1 > gclsBase.FYearOfDate(dtmEndDate) Then
            ShowMsg Me.hWnd, "年度已在当前帐套的开始时间和结束时间之外了！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "警告信息"
            spinYear.Text = Format(gclsBase.FYearOfDate(dtmStartDate), "####")
    '        Exit Sub
        End If
End If
    If bz = True Then
        bz = False
        GoTo endpiont
    End If
    
    sDate = 0
    eDate = 0
    Call gclsBase.DateOfPeriod(Year1, Month1, sDate, eDate)
    SqlRecMaxNo
endpiont:
End Sub
'-----------------------------------------------
'从会计期间表中取出当前帐套的起始日期和结束日期(gclsbase.BaseDate)
'SDate   要返回的起始日期
'EDate   要返回的结束日期
'-----------------------------------------------
Private Function GetBaseStartAndEndPeriod(ByVal intYear As Integer, sDate As Date, eDate As Date, PeriodNo As Integer) As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    
    GetBaseStartAndEndPeriod = True
    strSql = "select * from AccountYear WHERE intYear =" & intYear
    
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    If recTmp Is Nothing Then
        sDate = gclsBase.BaseDate
        eDate = gclsBase.BaseDate
        Exit Function
    End If
    If recTmp.BOF And recTmp.EOF Then
        sDate = gclsBase.BaseDate
        eDate = gclsBase.BaseDate
        recTmp.Close
        Set recTmp = Nothing
        Exit Function
    End If
    recTmp.MoveFirst
    sDate = recTmp!strStartDate
    recTmp.MoveLast
    eDate = recTmp!strEndDate
    PeriodNo = recTmp!bytPeriodNO
    recTmp.Close
'--------StartDate-------
    strSql = "SELECT strStartDate from Business "
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp Is Nothing Then
    Else
        If recTmp.BOF And recTmp.EOF Then
        Else
            If gclsBase.FYearOfDate(sDate) = gclsBase.FYearOfDate(recTmp!strStartDate) Then
                sDate = recTmp!strStartDate
            End If
        End If
        recTmp.Close
    End If
    Set recTmp = Nothing
End Function
'取当前帐套的开始年度和结束年度
Private Function GetStartAndEndYear(sYear As Integer, eYear As Integer) As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    
    GetStartAndEndYear = True
    strSql = "select intYear from accountyear order by intyear"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTmp Is Nothing Then
        sYear = gclsBase.AccountYear
        eYear = gclsBase.AccountYear
        Exit Function
    End If
    If recTmp.BOF And recTmp.EOF Then
        sYear = gclsBase.AccountYear
        eYear = gclsBase.AccountYear
        recTmp.Close
        Set recTmp = Nothing
        Exit Function
    End If
    recTmp.MoveLast
    eYear = recTmp!intYear
    recTmp.MoveFirst
    sYear = recTmp!intYear
    recTmp.Close
    Set recTmp = Nothing
End Function

Private Sub spinYear_KeyUp(KeyCode As Integer, Shift As Integer, bCancel As Long)
    If KeyCode = 13 Then
        spinMonth.SetFocus
    ElseIf KeyCode = vbKeyEscape Then
        Unload Me
    End If
End Sub