07. 2 примера, один добавление из таблицы, а другой из файла показывают как можно внести в отчет логотипы и т.п.
' Из файла
Private Sub ОбластьДанных_Format(Cancel As Integer, FormatCount As Integer)
Me.picFromFile.Picture = Application.CurrentProject.Path _
"\" Me.Рисунок
End Sub
' Вставить рисунок из таблицы sTable
Private Sub InsertPicture(ctrl As Control, sTable As String)
Dim dbs As Database, rst As Recordset
On Error GoTo 999 'Обработка ошибки
Set dbs = CurrentDb 'Текущая база данных
Set rst = dbs.OpenRecordset(sTable) 'Открываем таблицу
If rst.RecordCount 0 Then
rst.MoveLast 'Заполняем запрос
rst.MoveFirst 'Устанавливаем позицию
ctrl.Picture = Application.CurrentProject.Path _
"\" rst!Рисунок 'Полное имя файла
End If
rst.Close
999:
Err.Clear 'Сброс ошибки
End Sub
02. Использование ALTER COLUMN в запросе SQL решит эту проблему
Private Sub butExecute_Click()
Dim dbs As Database
On Error GoTo 999
CurrentDb.Execute _
"ALTER TABLE [Пример 01] ALTER COLUMN [Описание] TEXT(" _
Me.fldSize ")"
MsgBox "Размер поля в таблице 'Примеры 01': " vbCrLf _
Me.fldSize " символов(а)", vbInformation, "Изменение поля"
Exit Sub
999:
MsgBox Err.Description, vbCritical, "Изменение поля"
Err.Clear
End Sub
13. Это делается в конструкторе отчета, смотрите пример файла mdb
'12. Печать на нескольких принтерах
Private Sub Example12_Click()
On Error GoTo 999 'Выход по ошибке
While (1) 'Назначаем бесконечный цикл
DoCmd.SelectObject acReport, "Пример 12", True 'Выбираем отчет в БД
DoCmd.RunCommand acCmdPrint 'Вызываем печать
Wend
999:
Err.Clear 'Очищаем ошибку при отмене печати
DoCmd.SelectObject acForm, Me.Name 'Выбираем форму
End Sub
13. В этом примере написано, как можно создать собственный счетчик, если вы используете форму для редактирования записей. Это не есть полное решение задачи, т.к. в таблицу Access нельзя добавить собственную функцию. У SQL Server это можно сделать. Он также позволяет и переименовать данные счетчика, в Access это не получится. Суть алгоритма: используем событие текущей записи и присваиваем новое значение событию по умолчанию. Таким образом, если пользователь будет находится в новой записи, данные не будут добавлены.
' Получение счетчика записей
Private Sub Form_Current()
If Me.NewRecord = True Then
Me.MyNumber.DefaultValue = Nz(DMax("MyNumber", "Пример 13", ""), 0) + 1
End If
End Sub
02. Используя оператор Type, можно создать собственный массив данных. Например, линий
Type colorLINE 'назначаем тип объекта
x1 As Long 'Абцисса начала
y1 As Long 'Ордината начала
x2 As Long 'Абцисса конца
y2 As Long 'Ордината конца
color As Long 'Цвет линии
'... Здесь Вы можете добавить любые объекты, переменные и т.п.
End Type
Dim myLine(2) As colorLINE 'выделяем массив для линий
'==============================================================
' Заполнение массива
Public Function funArrayLines(frm As Form)
Dim i As Integer
For i = 0 To 1
Select Case i
Case 0 'Горизонтальная линия
myLine(i).x2 = 100
myLine(i).color = RGB(255, 0, 0) 'Красный цвет
frm.Линия1.BorderColor = myLine(i).color 'Меняем цвет линии
Case 1 'Вертикальная линия
myLine(i).y2 = 100
myLine(i).color = RGB(0, 255, 0) 'Зеленый цвет
frm.Линия2.BorderColor = myLine(i).color 'Меняем цвет линии
End Select
Next i
End Function
01. Данный пример показывает вам, как можно загрузить все рисунки из каталога в базу данных. Обратите внимание на Dir("\*.bmp", vbNormal) - таким простейшим и древним способом можно получить все файлы из каталога. Рекомендации для хранения рисунков. Лучше использовать отдельные файлы, хотя в некоторых случаях это может пригодится.
' Загрузить рисунки из файла в таблицу
' (Для работы программы в папке должны быть файлы *.bmp)
'
Private Sub butExecute_Click()
Dim myBmp As String, myDir As String
On Error GoTo 999
' Папка для поиска
myDir = Application.CurrentProject.Path
' Находим файл с расширением bmp
myBmp = Dir(myDir "\*.bmp", vbNormal)
Do While Len(myBmp) 0 'Проверяем файл
Me.Файл = myBmp 'Файл bmp
Me.Папка = myDir 'Каталог
Me.Рисунок.OLETypeAllowed = acOLEEmbedded 'Назначаем режим вставки
Me.Рисунок.SourceDoc = Me.Папка "\" Me.Файл 'Путь файла
Me.Рисунок.Action = acOLECreateEmbed 'Вставляем объект в таблицу
'Переход к новой записи
myBmp = Dir 'Новый файл bmp
DoCmd.RunCommand acCmdRecordsGoToNew ' Переходим на новую запись
Loop
DoCmd.RunCommand acCmdRecordsGoToFirst 'Начало записей
MsgBox "Рисунки загружены!", vbExclamation, "Графика"
Exit Sub
999:
MsgBox Err.Description 'Ошибка
Err.Clear
End Sub
04. Это делается в конструкторе отчетов, поэтому для понимания этого примера откройте mdb файл
19. Таблицу в подчиненной форме невозможно раскрасить простым способом, для этого надо знать некоторые хитрости. Посмотрите этот пример.
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
'Назначаем цвет для всей таблицы
Me.DatasheetBackColor = RGB(180, 210, 180)
'Назначим в поле 'Дата' такое форматирование, чтобы
'выделить дату = 20 сентября 2000 года
With Me.Дата
.FormatConditions.Delete 'Удаляем все условия
'Назначение форматирования
.FormatConditions.Add acFieldValue, acEqual, "#09/20/2000#"
'Изменение цвета ячейки
With .FormatConditions(0)
.BackColor = 13434828 'Цвет фона
.FontBold = True 'Толщина букв
.ForeColor = RGB(255, 0, 0) 'Цвет символов - красный
End With
End With
'Назначим в поле 'Книга' такое форматирование, при котором
'будут отображаться строки с полем Сумма 30 рублей
With Me.Книга
.FormatConditions.Delete 'Удаляем все условия
.FormatConditions.Add acExpression, , "[Сумма]30" 'выражение
.FormatConditions(0).BackColor = 12632256 'Серый цвет фона
End With
'Назначим в поле 'Сумма' такое форматирование, при котором
'при входе в поле будет меняться цвет символов
With Me.Сумма
.FormatConditions.Delete 'Удаляем все условия
.FormatConditions.Add acFieldHasFocus 'Назначаем фокус
.FormatConditions(0).ForeColor = RGB(0, 0, 255) 'Синий цвет
.FormatConditions.Add acFieldValue, acBetween, "200", "500"
.FormatConditions(1).ForeColor = 255
End With
Err.Clear
End Sub
20. Для округления математических полей в форме можно использовать функцию формат.
Private Sub Form_Open(Cancel As Integer)
Me.myFormat = "0.00"
Me.myИтого = Format(Me.myNumber, Me.myFormat)
End Sub
21. Это достаточно гибкий способ менять источник данных в вашей форме. Он не использует строковые переменные, а применяет ключевое слово set для запроса данных из DAO или ADO.
Private Sub Form_Open(Cancel As Integer)
Me.Дата = DateSerial(2005, 9, 20)
butDAOrecordset_Click
End Sub
Private Sub Дата_AfterUpdate()
butDAOrecordset_Click
End Sub
Private Sub butADOrecordset_Click()
Dim rst As ADODB.Recordset
' Создание запроса
Set rst = New ADODB.Recordset
' Заполняем запрос
With rst
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = "[Мои книги]"
.Open , CurrentProject.Connection, , , adCmdTable
End With
Set Me.subForm.Form.Recordset = rst
End Sub
Private Sub butDAOrecordset_Click()
Dim strParm As String, strSQL As String
Dim qry As DAO.QueryDef, dbs As DAO.Database
Set dbs = CurrentDb
Set qry = dbs.QueryDefs("qryExample22")
qry.Parameters("paramДата") = Nz(Me.Дата, Date)
Set Me.subForm.Form.Recordset = qry.OpenRecordset
' strParm = "PARAMETERS [paramДата] DATETIME; "
' strSQL = strParm "SELECT * FROM [Мои книги] WHERE [Дата]=[paramДата]"
' Me.Список.Form.InputParameters = "paramДата DateTime=#09/20/2000#"
End Sub