Разработать базу данных любителей кошек

End Sub

 

Private Sub fmas_print_Click()

On Error GoTo Err_all_print_Click

 

    Dim stDocName As String

 

    stDocName = "FiltrMas"

    DoCmd.OpenReport stDocName, acNormal

 

Exit_all_print_Click:

    Exit Sub

 

Err_all_print_Click:

    MsgBox Err.Description

    Resume Exit_all_print_Click

   

End Sub

 

Private Sub fmas_print_file_Click()

On Error GoTo Err_all_print_file_Click

 

    Dim stDocName As String

 

    stDocName = "FiltrMas"

    DoCmd.OutputTo acReport, stDocName

 

Exit_all_print_file_Click:

    Exit Sub

 

Err_all_print_file_Click:

    MsgBox Err.Description

    Resume Exit_all_print_file_Click

   

End Sub

 

Private Sub fmas_print_scr_Click()

DoCmd.OpenReport "FiltrMas", acViewPreview

End Sub

 

FiltrShow

 

Option Compare Database

 

Private Sub fsh_exit_Click()

DoCmd.Close

End Sub

 

Private Sub fsh_find_Click()

On Error GoTo Err_all_find_Click

 

 

    Screen.PreviousControl.SetFocus

    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

 

Exit_all_find_Click:

    Exit Sub

 

Err_all_find_Click:

    MsgBox Err.Description

    Resume Exit_all_find_Click

   

End Sub

 

Private Sub fsh_main_Click()

DoCmd.OpenForm "Main"

End Sub

 

Private Sub fsh_print_Click()

On Error GoTo Err_all_print_Click

 

    Dim stDocName As String

 

    stDocName = "FiltrShow"

    DoCmd.OpenReport stDocName, acNormal

 

Exit_all_print_Click:

    Exit Sub

 

Err_all_print_Click:

    MsgBox Err.Description

    Resume Exit_all_print_Click

   

End Sub

 

Private Sub fsh_print_file_Click()

On Error GoTo Err_all_print_file_Click

 

    Dim stDocName As String

 

    stDocName = "FiltrShow"

    DoCmd.OutputTo acReport, stDocName

 

Exit_all_print_file_Click:

    Exit Sub

 

Err_all_print_file_Click:

    MsgBox Err.Description

    Resume Exit_all_print_file_Click

   

End Sub

 

Private Sub fsh_print_scr_Click()

DoCmd.OpenReport "FiltrShow", acViewPreview

End Sub

 

ViewAll

 

Option Compare Database

 

Private Sub all_add_Click()

DoCmd.OpenForm "AddCat"

End Sub

 

Private Sub all_del_Click()

DoCmd.OpenQuery "DeleteCat", acViewNormal, acReadOnly

End Sub

 

Private Sub all_exit_Click()

DoCmd.Close

End Sub

 

Private Sub all_filtr_Click()

DoCmd.OpenForm "Filtr"

End Sub

 

Private Sub all_find_Click()

On Error GoTo Err_all_find_Click

 

 

    Screen.PreviousControl.SetFocus

    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

 

Exit_all_find_Click:

    Exit Sub

 

Err_all_find_Click:

    MsgBox Err.Description

    Resume Exit_all_find_Click

   

End Sub

 

Private Sub all_main_Click()

DoCmd.OpenForm "Main"

End Sub

 

Private Sub all_print_scr_Click()

DoCmd.OpenReport "ShowsResults", acViewPreview

End Sub

Private Sub all_print_Click()

On Error GoTo Err_all_print_Click

 

    Dim stDocName As String

 

   stDocName = "ShowsResults"

    DoCmd.OpenReport stDocName, acNormal

 

Exit_all_print_Click:

    Exit Sub

 

Err_all_print_Click:

    MsgBox Err.Description

    Resume Exit_all_print_Click

   

End Sub

Private Sub all_print_file_Click()

On Error GoTo Err_all_print_file_Click

 

    Dim stDocName As String

 

    stDocName = "ShowsResults"

    DoCmd.OutputTo acReport, stDocName

 

Exit_all_print_file_Click:

    Exit Sub

 

Err_all_print_file_Click:

    MsgBox Err.Description

    Resume Exit_all_print_file_Click

   

End Sub

 

ViewAwards

 

Option Compare Database

 

Private Sub aw_add_Click()

DoCmd.OpenForm "AddAward"

End Sub

 

Private Sub aw_del_Click()

DoCmd.OpenQuery "DeleteAward", acViewNormal, acReadOnly

End Sub

 

Private Sub aw_exit_Click()

DoCmd.Close

End Sub

 

Private Sub aw_find_Click()

On Error GoTo Err_all_find_Click

 

 

    Screen.PreviousControl.SetFocus

    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

 

Exit_all_find_Click:

    Exit Sub

 

Err_all_find_Click:

    MsgBox Err.Description

    Resume Exit_all_find_Click

   

End Sub

 

Private Sub aw_main_Click()

DoCmd.OpenForm "Main"

End Sub

 

Private Sub aw_print_Click()

On Error GoTo Err_all_print_Click

 

    Dim stDocName As String

 

    stDocName = "AD_award"

    DoCmd.OpenReport stDocName, acNormal

 

Exit_all_print_Click:

    Exit Sub

 

Err_all_print_Click:

    MsgBox Err.Description

    Resume Exit_all_print_Click

   

End Sub

 

Private Sub aw_print_file_Click()

On Error GoTo Err_all_print_file_Click

 

    Dim stDocName As String

 

    stDocName = "AD_award"

    DoCmd.OutputTo acReport, stDocName

 

Exit_all_print_file_Click:

    Exit Sub

 

Err_all_print_file_Click:

    MsgBox Err.Description

    Resume Exit_all_print_file_Click

   

End Sub

 

Private Sub aw_print_scr_Click()

DoCmd.OpenReport "AD_award", acViewPreview

End Sub

 

ViewCats

 

Option Compare Database

 

Private Sub cat_add_Click()

DoCmd.OpenForm "AddADCat"

End Sub

 

Private Sub cat_del_Click()

DoCmd.OpenQuery "DeleteCat", acViewNormal, acReadOnly

End Sub

 

Private Sub cat_exit_Click()

DoCmd.Close

End Sub

 

Private Sub cat_find_Click()

On Error GoTo Err_all_find_Click

 

 

    Screen.PreviousControl.SetFocus

    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

 

Exit_all_find_Click:

    Exit Sub

 

Err_all_find_Click:

    MsgBox Err.Description

    Resume Exit_all_find_Click

   

End Sub

 

Private Sub cat_main_Click()

DoCmd.OpenForm "Main"

End Sub

 

Private Sub cat_print_Click()

On Error GoTo Err_all_print_Click

 

    Dim stDocName As String

 

    stDocName = "AD_cats"

    DoCmd.OpenReport stDocName, acNormal

 

Exit_all_print_Click:

    Exit Sub

 

Err_all_print_Click:

    MsgBox Err.Description

    Resume Exit_all_print_Click

   

End Sub

 

Private Sub cat_print_file_Click()

On Error GoTo Err_all_print_file_Click

 

    Dim stDocName As String

 

    stDocName = "AD_cats"

    DoCmd.OutputTo acReport, stDocName

 

Exit_all_print_file_Click:

    Exit Sub

 

Err_all_print_file_Click:

    MsgBox Err.Description

    Resume Exit_all_print_file_Click

   

End Sub

 

Private Sub cat_print_scr_Click()

DoCmd.OpenReport "AD_cats", acViewPreview

End Sub

 

ViewMasters

 

Option Compare Database

 

Private Sub mas_add_Click()

DoCmd.OpenForm "AddMas"

End Sub

 

Private Sub mas_del_Click()

DoCmd.OpenQuery "DeleteMaster", acViewNormal, acReadOnly

End Sub

 

Private Sub mas_exit_Click()

DoCmd.Close

End Sub

 

Private Sub mas_find_Click()

On Error GoTo Err_all_find_Click

 

 

    Screen.PreviousControl.SetFocus

    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

 

Exit_all_find_Click:

    Exit Sub

 

Err_all_find_Click:

    MsgBox Err.Description

    Resume Exit_all_find_Click

   

End Sub

 

Private Sub mas_main_Click()

DoCmd.OpenForm "Main"

End Sub

 

Private Sub mas_print_Click()

On Error GoTo Err_all_print_Click

 

    Dim stDocName As String

 

    stDocName = "Masters"

    DoCmd.OpenReport stDocName, acNormal

 

Exit_all_print_Click:

    Exit Sub

 

Err_all_print_Click:

    MsgBox Err.Description

    Resume Exit_all_print_Click

   

End Sub

 

Private Sub mas_print_file_Click()

On Error GoTo Err_all_print_file_Click

 

    Dim stDocName As String

 

    stDocName = "Masters"

    DoCmd.OutputTo acReport, stDocName

 

Exit_all_print_file_Click:

    Exit Sub

 

Err_all_print_file_Click:

    MsgBox Err.Description

    Resume Exit_all_print_file_Click

   

End Sub

 

Private Sub mas_print_scr_Click()

DoCmd.OpenReport "Masters", acViewPreview

End Sub

 

ViewShows

 

Option Compare Database

 

Private Sub show_add_Click()

DoCmd.OpenForm "AddShow"

End Sub

 

Private Sub show_del_Click()

DoCmd.OpenQuery "DeleteShow", acViewNormal, acReadOnly

End Sub

 

Private Sub show_exit_Click()

DoCmd.Close

End Sub

 

Private Sub show_find_Click()

On Error GoTo Err_all_find_Click

 

 

    Screen.PreviousControl.SetFocus

    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

 

Exit_all_find_Click:

    Exit Sub

 

Err_all_find_Click:

    MsgBox Err.Description

    Resume Exit_all_find_Click

   

End Sub

 

Private Sub show_main_Click()

DoCmd.OpenForm "Main"

End Sub

 

Private Sub show_print_Click()

On Error GoTo Err_all_print_Click

 

    Dim stDocName As String

 

    stDocName = "Shows"

    DoCmd.OpenReport stDocName, acNormal

 

Exit_all_print_Click:

    Exit Sub

 

Err_all_print_Click:

    MsgBox Err.Description

    Resume Exit_all_print_Click

   

End Sub

 

Private Sub show_print_file_Click()

On Error GoTo Err_all_print_file_Click

 

    Dim stDocName As String

 

    stDocName = "Shows"

    DoCmd.OutputTo acReport, stDocName

 

Exit_all_print_file_Click:

    Exit Sub

 

Err_all_print_file_Click:

    MsgBox Err.Description

    Resume Exit_all_print_file_Click

   

End Sub

 

Private Sub show_print_scr_Click()

DoCmd.OpenReport "Shows", acViewPreview

End Sub

 

Код модулей:

 

Module1

 

Option Compare Database

Global db As ADODB.Recordset

 

Sub Add_Mas(Name)

Dim NextId As Integer

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT `mas_id` FROM `Masters` ORDER BY `mas_id` DESC;", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

NextId = db.Fields("mas_id").Value + 1

db.Close

db.Open "INSERT INTO `Masters` values ('" & NextId & "','" & Name & "')", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные добавлены!"

End Sub

 

Sub edit_mas(Id)

Dim Pole As Control

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT Masters.fio FROM Masters WHERE Masters.mas_id = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

DoCmd.OpenForm "AddMas"

Set Pole = Forms!AddMas!add_mas_name

Pole.Value = db.Fields("fio").Value

Set Pole = Forms!AddMas!add_mas_id

Pole.Value = Id

Set Pole = Forms!AddMas!add_mas_edit

Pole.Visible = True

Set Pole = Forms!AddMas!add_mas_add

Pole.Visible = False

db.Close

End Sub

 

Sub EditBt_Mas(Id, Name)

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "UPDATE Masters SET Masters.fio = '" & Name & "' WHERE Masters.mas_id = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные обновлены..."

End Sub

 

Sub Add_Cat(Mas, Name, age, Show, aw)

Dim NextId As Integer

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT `cat_id` FROM `Cats` ORDER BY `cat_id` DESC;", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

NextId = db.Fields("cat_id").Value + 1

db.Close

db.Open "INSERT INTO `Cats` values ('" & NextId & "','" & Mas & "','" & Name & "','" & age & "','" & Show & "','" & aw & "')", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные добавлены!"

End Sub

 

Sub edit_cat(Id)

Dim Pole As Control

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT Cats.cmas_id, Cats.cat_name, Cats.age, Cats.csh_id, Cats.aw FROM Cats WHERE Cats.cat_id = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

DoCmd.OpenForm "AddCat"

Set Pole = Forms!AddCat!add_cat_mas

Pole.Value = db.Fields("cmas_id").Value

Set Pole = Forms!AddCat!add_cat_name

Pole.Value = db.Fields("cat_name").Value

Set Pole = Forms!AddCat!add_cat_age

Pole.Value = db.Fields("age").Value

Set Pole = Forms!AddCat!add_cat_show

Pole.Value = db.Fields("csh_id").Value

Set Pole = Forms!AddCat!add_cat_aw

Pole.Value = db.Fields("aw").Value

Set Pole = Forms!AddCat!add_cat_id

Pole.Value = Id

Set Pole = Forms!AddCat!add_cat_edit

Pole.Visible = True

Set Pole = Forms!AddCat!add_cat_add

Pole.Visible = False

db.Close

End Sub

 

Sub EditBt_Cat(Id, Mas, Name, age, Show, aw)

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "UPDATE Cats SET Cats.cmas_id = '" & Mas & "', Cats.cat_name = '" & Name & "', Cats.age = '" & age & "', Cats.csh_id = '" & Show & "', Cats.aw = '" & aw & "' WHERE Cats.cat_id = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные обновлены..."

End Sub

 

Sub Add_Show(Name, Data)

Dim NextId As Integer

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT `sh_id` FROM `Shows` ORDER BY `sh_id` DESC;", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

NextId = db.Fields("sh_id").Value + 1

db.Close

db.Open "INSERT INTO `Shows` values ('" & NextId & "','" & Name & "'," & Data & "')", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные добавлены!"

End Sub

 

Sub edit_show(Id)

Dim Pole As Control

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT Shows.sh_name, Shows.sh_date FROM Shows WHERE Shows.sh_id = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

DoCmd.OpenForm "AddShow"

Set Pole = Forms!AddShow!add_show_name

Pole.Value = db.Fields("sh_name").Value

Set Pole = Forms!AddShow!add_show_date

Pole.Value = db.Fields("sh_date").Value

Set Pole = Forms!AddShow!add_show_id

Pole.Value = Id

Set Pole = Forms!AddShow!add_show_edit

Pole.Visible = True

Set Pole = Forms!AddShow!add_show_add

Pole.Visible = False

db.Close

End Sub

 

Sub EditBt_Show(Id, Name, Data)

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "UPDATE Shows SET Shows.sh_name = '" & Name & "', Shows.sh_date = '" & Data & "' WHERE Shows.sh_id = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные обновлены..."

End Sub

 

Sub Add_Aw(Name)

Dim NextId As Integer

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT `Код` FROM `AD_award` ORDER BY `Код` DESC;", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

NextId = db.Fields("Код").Value + 1

db.Close

db.Open "INSERT INTO `AD_award` values ('" & NextId & "','" & Name & "')", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные добавлены!"

End Sub

 

Sub edit_aw(Id)

Dim Pole As Control

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT AD_award.Награда FROM AD_award WHERE AD_award.Код = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

DoCmd.OpenForm "AddAward"

Set Pole = Forms!AddAward!add_aw_name

Pole.Value = db.Fields("Награда").Value

Set Pole = Forms!AddAward!add_aw_id

Pole.Value = Id

Set Pole = Forms!AddAward!add_aw_edit

Pole.Visible = True

Set Pole = Forms!AddAward!add_aw_add

Pole.Visible = False

db.Close

End Sub

 

Sub EditBt_Aw(Id, Name)

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "UPDATE AD_award SET AD_award.Награда = '" & Name & "' WHERE AD_award.Код = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные обновлены..."

End Sub

 

Sub Add_AD_Cat(Name)

Dim NextId As Integer

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT `Код` FROM `AD_cats` ORDER BY `Код` DESC;", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

NextId = db.Fields("Код").Value + 1

db.Close

db.Open "INSERT INTO `AD_cats` values ('" & NextId & "','" & Name & "')", _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные добавлены!"

End Sub

 

Sub edit_adcat(Id)

Dim Pole As Control

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "SELECT AD_cats.Кошка FROM AD_cats WHERE AD_cats.Код  = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

DoCmd.OpenForm "AddADCat"

Set Pole = Forms!AddADCat!add_adcat_name

Pole.Value = db.Fields("Кошка").Value

Set Pole = Forms!AddADCat!add_adcat_id

Pole.Value = Id

Set Pole = Forms!AddADCat!add_adcat_edit

Pole.Visible = True

Set Pole = Forms!AddADCat!add_adcat_add

Pole.Visible = False

db.Close

End Sub

 

Sub EditBt_AD_Cat(Id, Name)

Set db = New ADODB.Recordset

db.CursorLocation = adUseClient

db.Open "UPDATE AD_cats SET AD_cats.Кошка = '" & Name & "' WHERE AD_cats.Код = " & Id, _

CurrentProject.Connection, adOpenKeyset, adLockOptimistic

MsgBox "Данные обновлены..."

End Sub

 

Module2

 

Option Explicit

 

Function OpenStartup() As Boolean

On Error GoTo OpenStartup_Err

    If IsItAReplica() Then

       DoCmd.Close

    Else

        If (CurrentDb().Properties("StartupForm") = "StartUp" Or _

            CurrentDb().Properties("StartupForm") = "Form.StartUp") Then

                        Forms!StartUp!HideStartupForm = False

        Else

            Forms!StartUp!HideStartupForm = True

        End If

    End If

  

OpenStartup_Exit:

    Exit Function

       

OpenStartup_Err:

    Const conPropertyNotFound = 3270

    If Err = conPropertyNotFound Then

        Forms!StartUp!HideStartupForm = True

        Resume OpenStartup_Exit

    End If

End Function

 

Function HideStartupForm()

On Error GoTo HideStartupForm_Err

        If Forms!StartUp!HideStartupForm Then

           CurrentDb().Properties("StartupForm") = "Main"

        Else

           CurrentDb().Properties("StartupForm") = "StartUp"

        End If

   

        Exit Function

       

HideStartupForm_Err:

    Const conPropertyNotFound = 3270

    If Err = conPropertyNotFound Then

        Dim db As DAO.Database

        Dim prop As DAO.Property

        Set db = CurrentDb()

        Set prop = db.CreateProperty("StartupForm", dbText, "StartUp")

        db.Properties.Append prop

        Resume Next

    End If

End Function

Function CloseForm()

    DoCmd.Close

    DoCmd.OpenForm ("Main")

End Function

Function IsItAReplica() As Boolean

On Error GoTo IsItAReplica_Err

 

    Dim blnReturnValue As Boolean

   

    blnReturnValue = False