---

Option Compare Database
Option Explicit

' ===== НАСТРОЙКА: имена объектов из вашей базы =====
Private Function GetQueries() As Variant
    GetQueries = Array("sql1_1", "sql1_2", "sql1_4", "sql1_5")
End Function

Private Function GetQueryCaptions() As Variant
    GetQueryCaptions = Array("Список студентов", "Студенты 1 курса", "Средний балл", "Количество студентов по курсам")
End Function

Private Function GetForms() As Variant
    GetForms = Array("Конструктор_Студент", "Мастер_Студент", "Разделённый_Студент", "Студент_Составная")
End Function

Private Function GetReports() As Variant
    GetReports = Array("Студент", "Студент1", "Студент2", "Студент3")
End Function
' ===================================================

Public Sub BuildAllMenus()
    Dim q, qc, f, r
    Dim i As Long
    Dim capsQ(4) As String, actsQ(4) As String
    Dim capsF(4) As String, actsF(4) As String
    Dim capsR(4) As String, actsR(4) As String
    Dim capsM(4) As String, actsM(4) As String
    Dim back As String

    q = GetQueries(): qc = GetQueryCaptions(): f = GetForms(): r = GetReports()
    back = "=OpenF(""Главное меню"")"

    ' 1.1 Четыре макроса
    On Error GoTo MacroErr
    For i = 0 To 3
        MakeMacro "Макрос_Запрос" & (i + 1), CStr(q(i))
    Next i
    On Error GoTo 0

    ' 1.2 Меню запросов (через макросы)
    For i = 0 To 3
        capsQ(i) = CStr(qc(i))
        actsQ(i) = "Макрос_Запрос" & (i + 1)
    Next i
    capsQ(4) = "В главное меню": actsQ(4) = back
    MakeMenu "Меню запросов", capsQ, actsQ

    ' 1.3 Меню форм
    For i = 0 To 3
        capsF(i) = CStr(f(i))
        actsF(i) = "=OpenF(""" & f(i) & """)"
    Next i
    capsF(4) = "В главное меню": actsF(4) = back
    MakeMenu "Меню форм", capsF, actsF

    ' 1.4 Меню отчётов
    For i = 0 To 3
        capsR(i) = CStr(r(i))
        actsR(i) = "=OpenR(""" & r(i) & """)"
    Next i
    capsR(4) = "В главное меню": actsR(4) = back
    MakeMenu "Меню отчётов", capsR, actsR

    ' 1.5 Главное меню
    capsM(0) = "Меню запросов":   actsM(0) = "=OpenF(""Меню запросов"")"
    capsM(1) = "Меню форм":       actsM(1) = "=OpenF(""Меню форм"")"
    capsM(2) = "Меню отчётов":    actsM(2) = "=OpenF(""Меню отчётов"")"
    capsM(3) = "Выход в окно БД": actsM(3) = "=CloseMe()"
    capsM(4) = "Выход из Access": actsM(4) = "=QuitApp()"
    MakeMenu "Главное меню", capsM, actsM

    MsgBox "Готово! Откройте форму ""Главное меню"" и проверьте кнопки.", vbInformation
    Exit Sub

MacroErr:
    MsgBox "Не удалось создать макросы автоматически: " & Err.Description & vbCrLf & _
           "Создайте 4 макроса вручную (действие ОткрытьЗапрос) с именами " & _
           "Макрос_Запрос1 ... Макрос_Запрос4 и запустите BuildAllMenus заново.", vbExclamation
End Sub

' Создание макроса, открывающего запрос
Private Sub MakeMacro(macroName As String, queryName As String)
    Dim fn As String, h As Integer
    fn = Environ("TEMP") & "\tmpmacro.txt"
    h = FreeFile
    Open fn For Output As #h
    Print #h, "Version =196611"
    Print #h, "ColumnsShown =8"
    Print #h, "Begin"
    Print #h, "    Action =""OpenQuery"""
    Print #h, "    Argument =""" & queryName & """"
    Print #h, "    Argument =""Datasheet"""
    Print #h, "    Argument =""Edit"""
    Print #h, "End"
    Close #h
    On Error Resume Next
    DoCmd.DeleteObject acMacro, macroName
    On Error GoTo 0
    Application.LoadFromText acMacro, macroName, fn
    Kill fn
End Sub

' Создание формы-меню с заголовком и кнопками
Private Sub MakeMenu(menuName As String, caps As Variant, acts As Variant)
    Dim frm As Form, ctl As Control, i As Long, n As String

    On Error Resume Next
    DoCmd.Close acForm, menuName
    DoCmd.DeleteObject acForm, menuName
    On Error GoTo 0

    Set frm = CreateForm
    n = frm.Name
    frm.Caption = menuName
    frm.NavigationButtons = False
    frm.RecordSelectors = False
    frm.DividingLines = False
    frm.AutoCenter = True

    Set ctl = CreateControl(n, acLabel, acDetail, , , 600, 300, 6000, 550)
    ctl.Caption = menuName
    ctl.FontSize = 20
    ctl.FontBold = True

    For i = 0 To UBound(caps)
        Set ctl = CreateControl(n, acCommandButton, acDetail, , , 600, 1200 + i * 700, 6000, 550)
        ctl.Name = "btn" & i
        ctl.Caption = caps(i)
        ctl.OnClick = acts(i)
    Next i

    DoCmd.Close acForm, n, acSaveYes
    DoCmd.Rename menuName, acForm, n
End Sub

' ===== Функции, которые вызывают кнопки =====
Public Function OpenF(n As String)
    DoCmd.OpenForm n
End Function

Public Function OpenR(n As String)
    DoCmd.OpenReport n, acViewPreview
End Function

Public Function CloseMe()
    DoCmd.Close acForm, Screen.ActiveForm.Name
End Function

Public Function QuitApp()
    DoCmd.Quit
End Function