Программно создайте кнопку, открывающую форму в доступе

Question

Когда моя база данных открыта, она показывает форму с «панель загрузки», которая сообщает о ходе соединения внешних таблиц и т. Д., Прежде чем показывать форму «Главное меню». В главном меню есть код, который программно генерирует форму за кулисами с кнопками на ней, и когда это делается, она сохраняет и переименовывает форму и назначает ее как SourceObject для подформы.

Все это прекрасно работает и денди, то есть до тех пор, пока я не решит сделать кнопки на самом деле полезными. В цикле, который генерирует кнопки, он добавляет код VBA в модуль подчиненной формы. По какой-то причине выполнение VBA завершает выполнение, а затем останавливается. Это приводит к тому, что форма (модальная) загрузка не исчезает, так как существует оператор If, который выполняет команду DoCmd.Close, чтобы закрыть форму загрузки, когда она была загружена. Он также нарушает функциональность, которая зависит от устанавливаемой глобальной переменной, поскольку глобальное значение очищается, когда выполнение останавливается.

Есть ли лучший способ создания кнопок, которые делают программно, не доходя до каналов. Прямо и записывая реальный код? Насколько мне бы хотелось, я вынужден сделать это в Access на случай, если я покину компанию, чтобы менее искусные сотрудники все еще могли работать с ней в мое отсутствие.

Ниже приведены биты и куски соответствующего кода, если это необходимо.

Form_USysSplash:

'Code that runs when the form is opened, before any processing. 
Private Sub Form_Open(Cancel As Integer) 
    'Don't mess with things you shouldn't be. 
    If g_database_loaded Then 
     MsgBox "Please don't try to run the Splash form directly.", vbOKOnly, "No Touching" 
     Cancel = True 
     Exit Sub 
    End If 

    'Check if the user has the MySQL 5.1 ODBC driver installed. 
    Call CheckMysqlODBC 'Uses elfin majykks to find if Connector/ODBC is installed, puts the result into g_mysql_installed 
    If Not g_mysql_installed Then 
     Cancel = True 
     DoCmd.OpenForm "Main" 
     Exit Sub 
    End If 
End Sub 

'Code that runs when the form is ready to render. 
Private Sub Form_Current() 

    'Prepare the form 
    boxProgressBar.width = 0 
    lblLoading.caption = "" 

    'Render the form 
    DoCmd.SelectObject acForm, Me.name 
    Me.Repaint 
    DoEvents 

    'Start the work 
    LinkOMTables 
    UpdateStatus "Done!" 

    DoCmd.OpenForm "Home" 
    f_done = True 
End Sub 

Private Sub Form_Timer() 'Timer property set to 100 
    If f_done Then DoCmd.Close acForm, Me.name 
End Sub 

Form_Home:

'Code run before the form is displayed. 
Private Sub Form_Load() 

    'Check if the user has the MySQL 5.1 ODBC driver installed. 
    'Header contains an error message and a download link 
    If Not g_mysql_installed Then 
     FormHeader.Visible = True 
     Detail.Visible = False 
    Else 
     FormHeader.Visible = False 
     Detail.Visible = True 
     CreateButtonList Me, Me.subTasks 
    End If 
End Sub 

'Sub to create buttons on the form's Detail section, starting at a given height from the top. 
Sub CreateButtonList(ByRef frm As Form, ByRef buttonPane As SubForm) 
    Dim rsButtons As Recordset 
    Dim newForm As Form 
    Dim newButton As CommandButton 
    Dim colCount As Integer, rowCount As Integer, curCol As Integer, curRow As Integer 
    Dim newFormWidth As Integer 
    Dim taskFormName As String, newFormName As String 

    Set rsButtons = CurrentDb.OpenRecordset("SELECT * FROM USysButtons WHERE form LIKE '" & frm.name & "'") 
    If Not rsButtons.EOF And Not rsButtons.BOF Then 

     taskFormName = "USys" & frm.name & "Tasks" 
     On Error Resume Next 
     If TypeOf CurrentProject.AllForms(taskFormName) Is AccessObject Then 
      buttonPane.SourceObject = "" 
      DoCmd.DeleteObject acForm, taskFormName 
     End If 
     Err.Clear 
     On Error GoTo 0 
     Set newForm = CreateForm 
     newFormName = newForm.name 
     With newForm 
      .Visible = False 
      .NavigationButtons = False 
      .RecordSelectors = False 
      .CloseButton = False 
      .ControlBox = False 
      .width = buttonPane.width 
      .HasModule = True 
     End With 

     rsButtons.MoveLast 
     rsButtons.MoveFirst 
     colCount = Int((buttonPane.width)/1584) 'Twips: 1440 in an inch. 1584 twips = 1.1" 
     rowCount = Round(rsButtons.RecordCount/colCount, 0) 
     newForm.Detail.height = rowCount * 1584 
     curCol = 0 
     curRow = 0 

     Do While Not rsButtons.EOF 
      Set newButton = CreateControl(newForm.name, acCommandButton) 
      With newButton 
       .name = "gbtn_" & rsButtons!btn_name 
       .Visible = True 
       .Enabled = True 
       .caption = rsButtons!caption 
       .PictureType = 2 
       .Picture = rsButtons!img_name 
       .PictureCaptionArrangement = acBottom 
       .ControlTipText = rsButtons!tooltip 
       .OnClick = "[Event Procedure]" 
       'This If block is the source of my headache. 
       If Not IsNull(rsButtons!open_query) And rsButtons!open_query <> "" Then 
        newForm.Module.InsertLines newForm.Module.CountOfLines, _ 
         "Private Sub gbtn_" & rsButtons!btn_name & "_Click()" 
        newForm.Module.InsertLines newForm.Module.CountOfLines, _ 
         "DoCmd.OpenQuery """ & rsButtons!open_query & """" 
        newForm.Module.InsertLines newForm.Module.CountOfLines, _ 
         "End Sub" & vbCrLf & vbCrLf 
       ElseIf Not IsNull(rsButtons!open_form) And rsButtons!open_form <> "" Then 
        newForm.Module.InsertLines newForm.Module.CountOfLines, _ 
         "Private Sub gbtn_" & rsButtons!btn_name & "_Click()" 
        newForm.Module.InsertLines newForm.Module.CountOfLines, _ 
         "DoCmd.OpenForm """ & rsButtons!open_form & """" 
        newForm.Module.InsertLines newForm.Module.CountOfLines, _ 
         "End Sub" & vbCrLf & vbCrLf 
       End If 
       .height = 1584 
       .width = 1584 
       .Top = 12 + (curRow * 1584) 
       .Left = 12 + (curCol * 1584) 
       .BackThemeColorIndex = 1 
       .HoverThemeColorIndex = 4 'Accent 1 
       .HoverShade = 0 
       .HoverTint = 40 '60% Lighter 
       .PressedThemeColorIndex = 4 'Accent 1 
       .PressedShade = 0 
       .PressedTint = 20 '80% Lighter 
      End With 
      curCol = curCol + 1 
      If curCol = colCount Then 
       curCol = 0 
       curRow = curRow + 1 
      End If 
      rsButtons.MoveNext 
     Loop 
     DoCmd.Close acForm, newForm.name, acSaveYes 
     DoCmd.Rename taskFormName, acForm, newFormName 
     buttonPane.SourceObject = taskFormName 
    End If 
End Sub 

Answer 1

Там нет необходимости писать код, а код выполняется, особенно, как вы пишете по существу один и тот же код снова и снова. Все, что вам нужно, это вызвать функцию вместо процедуры события.

В коде выше написать событие OnClick, как это:

If Not IsNull(rsButtons!open_query) And rsButtons!open_query <> "" Then 
    .OnClick = "=MyOpenForm(""" & rsButtons!open_form & """)" 
ElseIf Not IsNull(rsButtons!open_form) And rsButtons!open_form <> "" Then 
    .OnClick = "=MyOpenQuery(""" & rsButtons!open_form & """)" 
End If 

Затем создать эти два постоянных (Несгенерированный) функции где-то форма может их видеть:

Public Function MyOpenForm(FormName as String) 
    DoCmd.OpenForm FormName 
End Function 

Public Function MyOpenQuery(QueryName as String) 
    DoCmd.OpenQuery QueryName 
End Function 

И канавы написания кода в модуле.