Sub CreateFriendsTableComplete()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim prp As DAO.Property
Set db = CurrentDb()
' Удаляем старую таблицу, если ты ее уже создал, чтобы не было ошибок
On Error Resume Next
db.TableDefs.Delete "Друзья"
On Error GoTo 0
' Создаем новую таблицу
Set tdf = db.CreateTableDef("Друзья")
' 1. № п/п (Счетчик)
Set fld = tdf.CreateField("№ п/п", dbLong)
fld.Attributes = dbAutoIncrField
tdf.Fields.Append fld
' 2. Фамилия
tdf.Fields.Append tdf.CreateField("Фамилия", dbText, 50)
' 3. Имя
tdf.Fields.Append tdf.CreateField("Имя", dbText, 50)
' 4. Отчество
tdf.Fields.Append tdf.CreateField("Отчество", dbText, 50)
' 5. Телефон (с ограничением 16 символов)
Set fld = tdf.CreateField("Телефон", dbText, 16)
tdf.Fields.Append fld
' 6. Дата рождения
Set fld = tdf.CreateField("Дата рождения", dbDate)
tdf.Fields.Append fld
' 7. Увлечения
tdf.Fields.Append tdf.CreateField("Увлечения", dbText, 50)
' 8. Адрес
tdf.Fields.Append tdf.CreateField("Адрес", dbText, 255)
' 9. Индекс
tdf.Fields.Append tdf.CreateField("Индекс", dbInteger)
' 10. Эл_почта (Гиперссылка)
Set fld = tdf.CreateField("Эл_почта", dbMemo)
fld.Attributes = dbHyperlinkField
tdf.Fields.Append fld
' 11. Семейное положение (Для выпадающего списка)
Set fld = tdf.CreateField("Семейное положение", dbText, 50)
tdf.Fields.Append fld
' Сохраняем структуру таблицы в базу
db.TableDefs.Append tdf
' --- НАСТРОЙКА СПЕЦИФИЧНЫХ СВОЙСТВ (Маски, форматы, списки) ---
' Маска ввода для телефона
Set fld = tdf.Fields("Телефон")
SetProperty fld, "InputMask", dbText, """+7"" 000"" ""000"" ""00"" ""00;0;"
' Формат даты
Set fld = tdf.Fields("Дата рождения")
SetProperty fld, "Format", dbText, "Short Date"
' Настройка выпадающего списка (Мастер подстановок)
Set fld = tdf.Fields("Семейное положение")
SetProperty fld, "DisplayControl", dbInteger, 111 ' acComboBox
SetProperty fld, "RowSourceType", dbText, "Value List"
SetProperty fld, "RowSource", dbText, """замужем"";""не замужем"";""женат"";""не женат"""
' --- ВИЗУАЛЬЩИНА (Цвета и шрифты по заданию) ---
SetProperty tdf, "DatasheetBackColor", dbLong, RGB(200, 230, 255) ' Голубой фон
SetProperty tdf, "DatasheetGridlinesColor", dbLong, RGB(128, 0, 0) ' Темно-красная сетка
SetProperty tdf, "DatasheetForeColor", dbLong, RGB(128, 0, 0) ' Темно-красный текст
SetProperty tdf, "DatasheetFontItalic", dbBoolean, True ' Курсив
SetProperty tdf, "DatasheetFontHeight", dbInteger, 12 ' Размер 12 пт
MsgBox "Таблица 'Друзья' создана со всеми настройками!", vbInformation
End Sub
' Вспомогательная функция, так как Access требует создавать свойства, если их еще нет
Sub SetProperty(obj As Object, propName As String, propType As Integer, propVal As Variant)
Dim prp As DAO.Property
On Error GoTo ErrHand
obj.Properties(propName) = propVal
Exit Sub
ErrHand:
If Err.Number = 3270 Then ' Ошибка: свойство не найдено
Set prp = obj.CreateProperty(propName, propType, propVal)
obj.Properties.Append prp
Resume Next
End If
End Sub