Когда моя база данных открыта, она показывает форму с «полосой загрузки», которая сообщает о ходе связывания внешних таблиц и тому подобного, перед тем как отобразить форму «Главное меню».В главном меню есть код, который генерирует форму программно за кулисами с кнопками, а когда это сделано, он сохраняет и переименовывает форму и назначает ее как 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