22. Списки в формах могут иместь скрытие поля. О том, как можно их использовать указано в этом примере.
Private Sub butCalc_Click()
Dim i As Long, sum As Currency
With Me.myList
For i = 0 To .ListCount - 1
sum = sum + .Column(1, i)
Next
MsgBox "Всего записей: " .ListCount ", выбран номер: " .ListIndex ", сумма=" sum
End With
End Sub
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
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
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
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
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
04. Это делается в конструкторе отчетов, поэтому для понимания этого примера откройте mdb файл
06. В таблицах Access можно использовать разные цвета полей, для этого нужно знать их форматирование. Пример. !\ [Красный] или dd.mm.yyyy[Синий];;;"Нет даты". Для более детальной информации откройте этот пример.
07. Это пример необходим для того, чтобы использовать клавиатуру в ваших разработках. Обратите внимание какой код передает кнопка на клавиатуре для разных языков.
Option Compare Database
Option Explicit
'==============================================================
' Нажать клавишу клавиатуры
Public Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyF1 '0x70 F1 ключ
Case vbKeyF2 '0x71 F2 ключ
Case vbKeyF3 '0x72 F3 ключ
Case vbKeyF4 '0x73 F4 ключ
Case vbKeyF5 '0x74 F5 ключ
Case vbKeyF6 '0x75 F6 ключ
Case vbKeyF7 '0x76 F7 ключ
Case vbKeyF8 '0x77 F8 ключ
Case vbKeyF9 '0x78 F9 ключ
Case vbKeyF10 '0x79 F10 ключ
Case vbKeyLButton '0x1 Левая клавиша мыши
Case vbKeyRButton '0x2 Правая клавиша мыши
Case vbKeyCancel '0x3 CANCEL ключ
Case vbKeyMButton '0x4 Средняя клавиша мыши
Case vbKeyBack '0x8 BACKSPACE ключ
Case vbKeyTab: '0x9 TAB ключ
Case vbKeyClear '0xC CLEAR ключ
Case vbKeyReturn '0xD ENTER ключ
Case vbKeyShift '0x10 SHIFT ключ
Case vbKeyControl '0x11 CTRL ключ
Case vbKeyMenu '0x12 MENU ключ
Case vbKeyPause '0x13 PAUSE ключ
Case vbKeyCapital '0x14 CAPS LOCK ключ
Case vbKeyEscape '0x1B ESC ключ
Case vbKeySpace '0x20 SPACEBAR ключ
Case vbKeyPageUp '0x21 PAGE UP ключ
Case vbKeyPageDown '0x22 PAGE DOWN ключ
Case vbKeyEnd '0x23 END ключ
Case vbKeyHome '0x24 HOME ключ
Case vbKeyLeft '0x25 LEFT ARROW ключ
Case vbKeyUp '0x26 UP ARROW ключ
Case vbKeyRight '0x27 RIGHT ARROW ключ
Case vbKeyDown '0x28 DOWN ARROW ключ
Case vbKeySelect '0x29 SELECT ключ
Case vbKeyPrint '0x2A PRINT SCREEN ключ
Case vbKeyExecute '0x2B EXECUTE ключ
Case vbKeySnapshot '0x2C SNAPSHOT ключ
Case vbKeyInsert '0x2D INSERT ключ
Case vbKeyDelete '0x2E DELETE ключ
Case vbKeyHelp '0x2F HELP ключ
Case vbKeyNumlock '0x90 NUM LOCK ключ
Case Else
'MsgBox "Другой ключ"
End Select
Me.myKey.Caption = "Код кнопки клавиатуры: " Format(KeyCode, "000")
Me.myShift.Caption = "Код кнопки Shift: " Format(Shift, "000")
Me.myXY.Caption = "Координаты: -"
'Обнулить данные, чтобы не работали клавиши
'и другие "Alt-", "F1" и т.п.
KeyCode = 0
Shift = 0
End Sub
'==============================================================
' Открытие модуля
Private Sub butVBA_Click()
DoCmd.OpenModule Me.Module
End Sub
'==============================================================
' Загрузка формы
Private Sub Form_Load()
Me.KeyPreview = True 'Включить обработку клавиатуры
End Sub
'==============================================================
' Нажатие клавиши мыши
Private Sub Пример_7_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
Select Case Button
Case acLeftButton
Case acRightButton
Case acMiddleButton
End Select
Select Case Shift
Case acShiftMask
Case acCtrlMask
Case acAltMask
End Select
Me.myKey.Caption = "Кнопка мыши: " Format(Button, "000")
Me.myShift.Caption = "Код кнопки Shift: " Format(Shift, "000")
Me.myXY.Caption = "Координаты мыши в твипах: X=" X ", Y=" y
End Sub
'==============================================================
' Передвинуть мышь
Private Sub Пример_7_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Пример_7_MouseDown Button, Shift, X, y
End Sub
если Вам необходимо из Microsoft Access управлять файлами, то этот набор функций раскажет как это сделать. Вы сможете удалять, создавать и копировать папки.
' Создание пустой папки
' fs.CreateFolder "c:\a"
'
Private Sub butCreateFolder_Click()
On Error GoTo 999
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject") 'Создаем файловую систему
'Создаем папку
fs.CreateFolder Me.myFolder
Set fs = Nothing
MsgBox "Папка: " Me.myFolder " создана!", vbInformation, "Создание папки"
Exit Sub 'Выходим из программы
999:
MsgBox Err.Description
Err.Clear 'Очищаем поток от ошибок
End Sub
' Копирование папки c ее содержимым
' fs.CopyFolder "c:\a", "c:\a1"
'
Private Sub butCopyFolder_Click()
On Error GoTo 999
Dim fs, strNewFolder As String, flagExecute As Long
Set fs = CreateObject("Scripting.FileSystemObject") 'Создаем файловую систему
strNewFolder = Me.myFolder "1" ' Новое имя
flagExecute = MsgBox("Копировать папку: " vbNewLine _
Me.myFolder vbNewLine "в:" _
strNewFolder, vbExclamation + vbOKCancel, "Копирование папки")
If flagExecute = vbOK Then _
fs.CopyFolder Me.myFolder, strNewFolder ' Копирование папки
Set fs = Nothing
Exit Sub 'Выходим из программы
999:
MsgBox Err.Description
Err.Clear 'Очищаем поток от ошибок
End Sub
' Удаление папки c содержимым
' fs.DeleteFolder "c:\a"
'
Private Sub butDeleteFolder_Click()
On Error GoTo 999
If MsgBox("Удал��ть папку: " Me.myFolder, vbExclamation + vbOKCancel, "Удаление папки") = vbOK Then
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject") 'Создаем файловую систему
'Удаляем папку
fs.DeleteFolder Me.myFolder
Set fs = Nothing
End If
Exit Sub 'Выходим из программы
999:
MsgBox Err.Description
Err.Clear 'Очищаем поток от ошибок
End Sub
' Перемещение папки c содержимым
' fs.MoveFolder "c:\a", "c:\a1"
'
Private Sub butMoveFolder_Click()
On Error GoTo 999
Dim fs, strNewFolder As String, flagExecute As Long
Set fs = CreateObject("Scripting.FileSystemObject") 'Создаем файловую систему
strNewFolder = Me.myFolder "1" ' Новое имя
flagExecute = MsgBox("Переместить папку: " vbNewLine _
Me.myFolder vbNewLine "в:" _
strNewFolder, vbExclamation + vbOKCancel, "Перемещение папки")
If flagExecute = vbOK Then _
fs.MoveFolder Me.myFolder, strNewFolder ' Перемещение папки
Set fs = Nothing
Exit Sub 'Выходим из программы
999:
MsgBox Err.Description
Err.Clear 'Очищаем поток от ошибок
End Sub