Call check_bookstype
Call clear(50, 6)
Set ws = CreateWorkspace(name:="fun", UserName:="admin", Password:="", UseType:=dbUseJet)
Set db = ws.OpenDatabase("e:\temp\база.mdb", Options:=False)
Set rs = db.OpenRecordset("Проданные_МК")
rs.MoveFirst
i = 2
Do Until rs.EOF
' Вывод таблицы на рабочий лист Excel
Worksheets("Лист1").Cells(1, 1) = "Код"
Worksheets("Лист1").Cells(1, 2) = "Фирма покупатель"
Worksheets("Лист1").Cells(1, 3) = "Название МК"
Worksheets("Лист1").Cells(1, 4) = "Фирма производитель"
Worksheets("Лист1").Cells(1, 5) = "Дата продажи"
Worksheets("Лист1").Cells(1, 6) = "Цена"
If findb(rs) = True Then
' заполнение таблицы
Worksheets("Лист1").Cells(i, 1) = rs!Код
Worksheets("Лист1").Cells(i, 2) = rs!Покупатель
Worksheets("Лист1").Cells(i, 3) = rs!Имя
Worksheets("Лист1").Cells(i, 4) = rs!Производитель
Worksheets("Лист1").Cells(i, 5) = rs!Дата_продажи
Worksheets("Лист1").Cells(i, 6) = rs!Цена
i = i + 1
End If
rs.MoveNext
Loop
db.Close
End Sub
'функция проверки критериев поиска
Private Function findb(rs) As Boolean
Dim year1 As Integer
Dim year2 As Integer
findb = False
'проверка фирма производитель
If CheckBox4.Value = True And InStr(1, rs!Производитель, "Intel", 1) > 0 Then findb = True
If CheckBox5.Value = True And InStr(1, rs!Производитель, "MOM", 1) > 0 Then findb = True
If CheckBox6.Value = True And InStr(1, rs!Производитель, "TI", 1) > 0 Then findb = True
If CheckBox7.Value = True And InStr(1, rs!Производитель, "Asus", 1) > 0 Then findb = True
If CheckBox8.Value = True And InStr(1, rs!Производитель, "Sven", 1) > 0 Then findb = True
' Проверка фирмы покупателя
If CheckBox1.Value = True And InStr(1, rs!Покупатель, TextBox1.Text, 1) = 0 Then findb = False
' Проверка издательства
If CheckBox3.Value = True And InStr(1, rs!Имя, ComboBox1.Text, 1) = 0 Then findb = False
' Проверка по дате
If OptionButton2.Value = True And InStr(1, rs!Дата_продажи, TextBox2.Text, 1) = 0 Then findb = False
' Проверка по цене
If CheckBox9.Value = True And InStr(1, rs!Цена, TextBox3.Text, 1) = 0 Then findb = False
End Function
'Очишается рабочий лист Excel
Private Sub clear(n1, n2)
Dim i As Integer
Dim j As Integer
For i = 1 To n1
For j = 1 To n2
Worksheets("Лист1").Cells(i, j) = ""
Next
Next
End Sub
' проверка выбраны ли фирмы производителя
Private Sub check_bookstype()
Dim ret As Boolean
ret = True
If CheckBox4.Value = False And CheckBox5.Value = False And CheckBox6.Value = False And CheckBox7.Value = False And CheckBox8.Value = False Then
ret = False
End If
If ret = False Then
MsgBox "Будьте добры, укажите фирму производителя"
End If
' проверка запонено ли поле Фирма производитель
If CheckBox1.Value = True And InStr(1, TextBox1, "", 1) = 0 Then
MsgBox "Заполните поле Фирма покупатель"
End If
' проверка запонено ли поле Фирма производитель
If CheckBox9.Value = True And InStr(1, TextBox3, "", 1) = 0 Then
MsgBox "Заполните поле Цена"
End If
' проверка запонено ли поле название МК
If CheckBox3.Value = True And InStr(1, ComboBox1, "", 1) = 0 Then
MsgBox "Заполните поле Название МК"
End If
' проверка запонено ли поле Дата
If OptionButton2.Value = True And InStr(1, TextBox2, "", 1) = 0 Then
MsgBox "Заполните поле Дата"
End If
End Sub
' загрузка формы, начальная инициализация
Private Sub UserForm_Activate()
Dim ws As Workspace
Dim db As Database
Dim rs As Recordset
Call CheckBox1_Change
Call CheckBox3_Change
Call CheckBox9_Change
Call OptionButton2_Change
OptionButton1.Value = True
End Sub
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.