Откр_форму_Err:
MsgBox Error$
Resume Откр_форму_Exit
End Function
'------------------------------------------------------------
' Переход_Back
'
Function Переход_Back() '(Name_form As Form)
On Error GoTo Переход_Back_Err
Dim Dat_N As Date, Dat_T As Date
Dat_T = DateSerial(Year(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Month(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Day(DLookup("DateValue (Запись)", "Системная", "Код = 1")))
Dat_N = DateSerial(Year(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Month(DLookup("DateValue (Запись)", "Системная", "Код = 1")) - 1, Day(DLookup("DateValue (Запись)", "Системная", "Код = 1")))
If MsgBox("Текущий отчетный период" & Chr(13) & Chr(10) & _
Format(Dat_T, "mmmm yyyy") & Chr(13) & Chr(10) & _
"Следующий - " & Format(Dat_N, "mmmm yyyy") & Chr(13) & Chr(10) & _
"Будете переходить?", vbYesNo + vbInformation + vbDefaultButton1) = vbYes Then
Forms![Кнопочная форма]![Otch_per] = Dat_N
Otch_Per_Pr = Dat_N
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE DISTINCTROW Системная SET Системная.Запись = '" & Dat_N & "' WHERE (((Системная.Код)=1));"
Dat_N = DateSerial(Year(Otch_Per_Pr), Month(Otch_Per_Pr) - 1, Day(Otch_Per_Pr))
DoCmd.RunSQL "UPDATE DISTINCTROW Системная SET Системная.Запись = '" & Dat_N & "' WHERE (((Системная.Код)=2));"
Dat_N = DateSerial(Year(Otch_Per_Pr), Month(Otch_Per_Pr) + 1, Day(Otch_Per_Pr))
DoCmd.RunSQL "UPDATE DISTINCTROW Системная SET Системная.Запись = '" & Dat_N & "' WHERE (((Системная.Код)=3));"
DoCmd.RunSQL "DELETE Oplata_auto.* FROM Oplata_auto;"
DoCmd.RunSQL "INSERT INTO Oplata_auto SELECT Oplata_backup.* FROM Oplata_backup;"
End If
Переход_Back_Exit:
Exit Function
Переход_Back_Err:
Resume Переход_Back_Exit
' Переход_New
Function Переход_New() '(Name_form As Form)
On Error GoTo Переход_New_Err
Dat_N = DateSerial(Year(DLookup("DateValue (Запись)", "Системная", "Код = 1")), Month(DLookup("DateValue (Запись)", "Системная", "Код = 1")) + 1, Day(DLookup("DateValue (Запись)", "Системная", "Код = 1")))
'LineNew:
Oplata_aut
Saldo_new
'заполнение чистыми бланками требований
DoCmd.RunSQL "DELETE DISTINCTROW Treb.*, Treb.Data_nach FROM Treb WHERE (((Treb.Data_nach) Is Null));"
DoCmd.RunSQL "INSERT INTO Treb ( Code, Abon_nach ) SELECT DISTINCTROW [Partner]![CODE] & Format([Forms]![Кнопочная форма]![Otch_per],'mmyy') AS COD, Partner.CODE FROM Partner;"
Else
Переход_New_Exit:
Переход_New_Err:
Resume Переход_New_Exit
Public Function Del_period()
'Убираем меньше заданного периода
Dim Per_0 As String
' Per_0 = DateSerial(Year(DLookup("DateValue (Запись)", "Системная", "Код = 10")), Month(DLookup("DateValue (Запись)", "Системная", "Код = 10")), Day(DLookup("DateValue (Запись)", "Системная", "Код = 10")))
' Per_0 = DLookup("Запись", "Системная", "Код = 10")
Per_0 = "01/01/2002"
DoCmd.SetWarnings True
DoCmd.RunSQL "DELETE DISTINCTROW Nachisl.*, Nachisl.Data_nach FROM Nachisl WHERE (((Nachisl.Data_nach) < #" & Per_0 & "#));"
DoCmd.RunSQL "DELETE DISTINCTROW Oplata.*, Oplata.Data_oplat FROM Oplata WHERE (((Oplata.Data_oplat) < #" & Per_0 & "#));"
DoCmd.RunSQL "DELETE DISTINCTROW Saldo.*, Saldo.Mes FROM Saldo WHERE (((Saldo.Mes) < #" & Per_0 & "#));"
DoCmd.RunSQL "DELETE DISTINCTROW Treb.*, Treb.Data_nach FROM Treb WHERE (((Treb.Data_nach) < #" & Per_0 & "#));"
Public Function treb_begin()
DoCmd.RunSQL "DELETE DISTINCTROW Plat_tr.* FROM Plat_tr;"
DoCmd.RunSQL "INSERT INTO PLAT_TR ( CODE_TR, SUM_NACH, NDS_NACH, SUM_VSEGO ) SELECT DISTINCTROW Partner.CODE, Sum(Сумма_начислений.Sum_Sum_nach) AS Sum_Sum_Sum_nach, Sum(Сумма_начислений.Sum_NDS_nach) AS Sum_Sum_NDS_nach, Sum([Sum_Sum_nach]+[Sum_NDS_nach]) AS SUM_VSEGO FROM Partner INNER JOIN [Сумма_начислений] ON Partner.CODE = Сумма_начислений.Abon_nach GROUP BY Partner.CODE;"
DoCmd.OpenQuery "Обновл_Требован"
- Модуль для перевода чисел в текст прописью:
' определение внешней функции NumberToText
Private Declare Function NumberToText Lib "DIG2TEXT" (ByVal Num As Double, ByVal ObjID$, ByVal flags As Long, ByVal ResultVal$) As Long
Function CapitalizeFirst(Str)
' Переводит первую букву в поле на верхний регистр;
' оставляет остальные символы не измененными.
Dim strTemp As String
strTemp = Trim(Str)
CapitalizeFirst = UCase(Left(strTemp, 1)) & Mid(strTemp, 2)
Function Okruglen(Num As Currency)
Okruglen = Format(Num, "#0.00")
' Spaces256$ создает пустую строку длиной 256 символов
Function Spaces256$()
Temp$ = "0123456789abcdef"
Temp$ = Temp$ & Temp$ & Temp$ & Temp$
Spaces256$ = Temp$
' NumberToRussianText$ преобразует число Number в строку, в которой это число записано прописью
' на русском языке в соответствии с объектом ObjectID$. Если Flags = 256, то первый символ строки
' делается заглавным.
Function NumberToRussianText$(Number As Double, ObjectID$, flags As Long)
Dim ResultVal$, ResultLength As Long
ResultVal$ = Spaces256$()
ResultLength = NumberToText(Number, ObjectID$, flags, ResultVal$)
NumberToRussianText$ = Left$(ResultVal$, ResultLength)
' Пример использования функции NumberToRussianText$
'Sub ConvertToRusTextExample()
' ResultVal$ = NumberToRussianText$(123.5, "USD", 256)
' Debug.Print ResultVal$
'End Sub
- Модуль для служебных функций
Option Compare Database
Option Explicit
Public Kod_typ_dv As Integer
Public Archif As Boolean
Public Board As Integer
Public Obn As Boolean
' Restore_Form
Function Restore_Form(Name_form As Form)
On Error GoTo Restore_Form_Err
Dim frm As Form
Set frm = Name_form
frm.SetFocus
DoCmd.Restore
Restore_Form_Exit:
Restore_Form_Err:
Resume Restore_Form_Exit
Sub Set_Controls(Dostup As Integer)
'1- Запретить изменения, 2- разрешить
On Error GoTo Set_Controls_Err
Dim frm As Form, ctl As Control, D As Integer
Set frm = Screen.ActiveForm
' Перебирает все компоненты семейства Controls.
For Each ctl In frm.Controls
' Проверяет, является ли элемент управления списком или текстовым блоком
If ctl.ControlType = acComboBox Or ctl.ControlType = acTextBox Then
If Dostup = 1 Then
If ctl.Name = "ПолеПоиска" Then
With ctl
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15
