FrmAc......
Option Compare Database
Option Explicit
Function PencereGizle(NeYap As Long)
On Error Resume Next
If NeYap = 0 Then
    DoCmd.RunCommand acCmdAppMinimize
    DoCmd.ShowToolbar "Ribbon", acToolbarNo
Else
    DoCmd.ShowAllRecords
End If
End Function
Form_Kolleksiyon..............
Option Compare Database
Option Explicit
Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MsgBox Me.CurrentRecord
End Sub
Private Sub Form_Close()
DoCmd.Quit acQuitSaveAll
End Sub
Private Sub Form_Current()
Call ResimYerlestir
End Sub
Private Sub Form_Open(Cancel As Integer)
Me.Baslik = "iemnco Diecast KOLLEKSIYON Ve alinacaklar listesi"
Me.Secmece = 0: Me.Sorgu.Enabled = False
End Sub
Private Sub KartAc_Click()
DoCmd.OpenReport "Kart", acViewPreview, , "[SyraNo]=" & Me.SyraNo, acWindowNormal
End Sub
Private Sub Model_DblClick(Cancel As Integer)
If Len(Dir(CurrentProject.Path & "\ArabaResimleri\M" & Me.Model.Column(0) & ".png", vbNormal)) > 0 Then
Me.ResimYeri = CurrentProject.Path & "\ArabaResimleri\M" & Me.Model.Column(0) & ".png"
End If
End Sub
Private Sub Model_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.Mesaj = CurrentProject.Path & "\ArabaResimleri Klasorunde ki, Modele ait resimi yuklemek icin cift tiklayin"
End Sub
Private Sub Secmece_AfterUpdate()
Me.Sorgu.Enabled = IIf(Eval(Me.Secmece & " In(1,6)"), False, True)
Me.Sorgu.RowSource = IIf(Me.Secmece = 2, "Olcek", IIf(Me.Secmece = 3, "Sinif", IIf(Me.Secmece = 4, "Uretici", IIf(Me.Secmece = 5, "KimAldi", ""))))
Me.Sorgu = IIf(Eval(Me.Secmece & " In(1,6)"), "", "Lutfen Secim Yapiniz")
Me.Sorgu.Requery
If Eval(Me.Secmece & " In(1,6)") Then
Me.Filter = "[Alyndy]=" & IIf(Me.Secmece = 1, -1, IIf(Me.Secmece = 6, 0, ""))
Me.FilterOn = True
Me.Baslik = "iemnco Diecast " & IIf(Me.Secmece = 1, "KOLLEKSIYON", "alinacaklar") & " listesi"
End If
End Sub
Sub ResimYerlestir()
On Error GoTo Hata
Me.Resim.Picture = Me.ResimYeri
Exit Sub
Hata:
If Len(Dir(CurrentProject.Path & "\ArabaResimleri\ArbResYok.png", vbNormal)) > 0 Then
Me.Resim.Picture = CurrentProject.Path & "\ArabaResimleri\ArbResYok.png"
Else
Me.Resim.Picture = ""
End If
Err.Clear
End Sub
Private Sub Sorgu_AfterUpdate()
On Error Resume Next
If IsNull(Me.Sorgu) Then
DoCmd.RunCommand acCmdRemoveAllFilters
Me.Filter = "": Me.Baslik = "iemnco Diecast KOLLEKSIYON Ve alinacaklar listesi": Me.Secmece = 0
ElseIf Me.Secmece = 2 Then
Me.Filter = "[Ölçek]=" & Me.Sorgu
Me.Baslik = "iemnco Diecast KOLLEKSIYON ve ALINACAKLAR" & vbNewLine & Me.Sorgu.Column(0) & " Ölçegine ait listesi"
ElseIf Me.Secmece = 3 Then
Me.Filter = "[Synyf]=" & Me.Sorgu
Me.Baslik = "iemnco Diecast KOLLEKSIYON ve ALINACAKLAR" & vbNewLine & Me.Sorgu.Column(0) & " Synyfina ait listesi"
ElseIf Me.Secmece = 4 Then
Me.Filter = "[Üretici]=" & Me.Sorgu
Me.Baslik = "iemnco Diecast KOLLEKSIYON ve ALINACAKLAR" & vbNewLine & Me.Sorgu.Column(0) & " Üreticisine ait listesi"
ElseIf Me.Secmece = 5 Then
Me.Filter = "[KimAldy]=" & Me.Sorgu
Me.Baslik = "iemnco Diecast KOLLEKSIYON ve ALINACAKLAR" & vbNewLine & Me.Sorgu.Column(0) & " Tarafindan Alinanlarin listesi"
End If
Me.FilterOn = True
End Sub
Form_Menu....
Option Compare Database
Option Explicit
Private Sub Form_Open(Cancel As Integer)
Call PencereGizle(0)
Me.RecordSource = "Select 'Lutfen Islem icin Yukarida ki Butonlari kullanin' As Aciklama"
Me.Requery
End Sub
Private Sub Liste_AfterUpdate()
Me.RecordsetClone.FindFirst "[" & IIf(Me.Secmece = 1, "GenBasID", "TasarimciID") & "]=" & Me.Liste.Column(0)
Me.Bookmark = Me.RecordsetClone.Bookmark
End Sub
Private Sub Secmece_AfterUpdate()
If Me.Secmece = 3 Then
    DoCmd.OpenForm "Kollksiyon", acNormal, , , acFormEdit, acWindowNormal
    DoCmd.Close acForm, "Menu"
Else
    Me.Liste.RowSource = IIf(Me.Secmece = 1, "SELECT GenelBilgi.GenBasID, GenelBilgi.Baslik FROM GenelBilgi", "SELECT Tasarimcilar.TasarimciID, Tasarimcilar.Tasarimci FROM Tasarimcilar")
    Me.RecordSource = IIf(Me.Secmece = 1, "GenelBilgi", "Tasarimcilar")
    Me.Requery: Me.Liste.Requery
    Me.Liste = Me.Controls(IIf(Me.Secmece = 1, "GenBasID", "TasarimciID"))
End If
End Sub

Private Sub Secmece_DblClick(Cancel As Integer)
Call PencereGizle(1)
End Sub
Rapor_Kart.....
Option Compare Database
Option Explicit
Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
Call ResimYerlestir
End Sub
Sub ResimYerlestir()
On Error GoTo Hata
Reports!Kart!Resim.Picture = Reports!Kart!ResimYeri
Exit Sub
Hata:
Reports!Kart!Resim.Picture = CurrentProject.Path & "\ArabaResimleri\ArbResYok.png"
End Sub
Private Sub Report_Open(Cancel As Integer)
DoCmd.Maximize
End Sub