Access 2016 создать таблицу со свойствами поля для выпадающего списка

Question

Я пытаюсь понять, как использовать подпрограмму создания таблицы в Access 2016, чтобы добавить поле со свойством элемента управления, установленным в поле со списком.

Используя код, который я почерпнул из различных источников, мне удалось запустить следующее, за исключением создания поля со списком.

Для самой таблицы необходимо настроить комбинированный список, поскольку он в конечном итоге загружается в SharePoint.

Пожалуйста помоги?

Sub maketable()
Dim db As DAO.Database
 Dim myTable As DAO.TableDef
 Dim myField As DAO.Field

     Set db = CurrentDb

     Set myTable = db.CreateTableDef("TestTable")
         With myTable
         .Fields.Append .CreateField("DateD", dbDate)
         .Fields.Append .CreateField("Description", dbText)
         .Fields.Append .CreateField("Num1", dbDouble)
         .Fields.Append .CreateField("Num2", dbDouble)
         .Fields.Append .CreateField("yesno", dbBoolean)
         .Fields.Append .CreateField("listme", dbText)
     End With

     db.TableDefs.Append myTable

    Set myField = myTable.Fields("DateD")
     Call SetDAOProperty(myField, "Format", dbText, "Short Date")

    Set myField = myTable.Fields("Num1")
     Call SetDAOProperty(myField, "DecimalPlaces", dbByte, 2)
     Call SetDAOProperty(myField, "Format", dbText, "Standard")

     Set myField = myTable.Fields("listme")
     Call SetDAOProperty(myField, "DisplayControl", dbText, acComboBox)
     Call SetDAOProperty(myField, "RowSourceType", dbText, acvaluelist)
     Call SetDAOProperty(myField, "RowSource", dbText, "Test1;Test2")

    Application.RefreshDatabaseWindow

     Set myField = Nothing
     Set myTable = Nothing
     Set db = Nothing

End Sub

Function SetDAOProperty( _
     WhichObject As Object, _
     PropertyName As String, _
     PropertyType As Integer, _
     PropertyValue As Variant _
 ) As Boolean
 On Error GoTo ErrorHandler

Dim prp As DAO.Property

    WhichObject.Properties(PropertyName) = PropertyValue
     WhichObject.Properties.Refresh
     SetDAOProperty = True

Cleanup:
     Set prp = Nothing
     Exit Function

ErrorHandler:
     Select Case Err.Number
         Case 3270 ' "Property not found"
             Set prp = WhichObject.CreateProperty( _
                 PropertyName, _
                 PropertyType, _
                 PropertyValue _
             )
             WhichObject.Properties.Append prp
             WhichObject.Properties.Refresh
             SetDAOProperty = True
         Case Else
             MsgBox Err.Number & ": " & Err.Description
             SetDAOProperty = False
     End Select
     Resume Cleanup

 End Function

Answer 1

Вы почти у цели, нужно всего два изменения:

1.

Call SetDAOProperty(myField, "DisplayControl", dbText, acComboBox)

DisplayControl это не текст, а целочисленное свойство:

Call SetDAOProperty(myField, "DisplayControl", dbInteger, acComboBox)

2.

Здесь редактор VBA уже дает подсказку, что есть проблема:

Call SetDAOProperty(myField, "RowSourceType", dbText, acvaluelist)

acvaluelist не существует. RowSourceType является текстовым свойством, правильное назначение:

Call SetDAOProperty(myField, "RowSourceType", dbText, "Value List")

Примечание: 2-й был бы поднят, имея Option Explicit в верхней части каждого модуля. Он обеспечивает декларацию переменных и сообщает незадекларированные или неправильно написанные переменные / константы во время компиляции.

Чтобы это было автоматически в новых модулях, установите параметр " Требовать объявление переменной" в редакторе VBA. Это действительно необходимо для разработки VBA.