Загрузка данных


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