Function ExelI()
Dim Db As Database
Dim Rs As Recordset
Dim Temp
Dim ExelO As Object
Dim Celija As Object
Dim Red As Integer, Kolona As Integer
Dim I As Integer

On Error GoTo Greska:
Set Db = CurrentDb()
Temp = Db_Putanja
Set Rs = Forms![T_Pregled_DA_G]![T_Pregled_DA_P subform].Form.RecordsetClone
Set ExelO = CreateObject("excel.Application")
FileCopy Temp & "qb.dll", Temp & "Pregled.xls"
ExelO.Workbooks.Open (Temp & "Pregled.xls")

Red = 5
Kolona = 3
Set Celija = ExelO.Cells(Red, Kolona)
Temp = Forms![T_Pregled_DA_G]![Referent_prodaje].Column(1)
Celija.Value = Temp
Red = 6
Kolona = 3
Set Celija = ExelO.Cells(Red, Kolona)
Temp = Forms![T_Pregled_DA_G]![Datum]
Celija.Value = Temp
Red = 7
Kolona = 3
Set Celija = ExelO.Cells(Red, Kolona)
Temp = Forms![T_Pregled_DA_G]![Pocetak_rada]
Celija.Value = Temp
Red = 8
Kolona = 3
Set Celija = ExelO.Cells(Red, Kolona)
Temp = Forms![T_Pregled_DA_G]![Zavrsetak_rada]
Celija.Value = Temp
Red = 9
Kolona = 3
Set Celija = ExelO.Cells(Red, Kolona)
Temp = Forms![T_Pregled_DA_G]![Dnevna_kilometraza]
Celija.Value = Temp
Red = 10
Kolona = 3
Set Celija = ExelO.Cells(Red, Kolona)
Temp = Forms![T_Pregled_DA_G]![Broj_posjecenih_DM]
Celija.Value = Temp
Red = 15
Rs.MoveFirst
Do While Not Rs.EOF
Red = Red + 1
If Red > 35 Then
ExelO.Rows("35:35").copy
ExelO.Rows(Red & ":" & Red).Insert Shift:=xlDown
End If
Kolona = 2
    For I = 0 To 17
    Kolona = I + 1
    Set Celija = ExelO.Cells(Red, Kolona)
    If Kolona = 1 Then
    Temp = Red - 15
    Else
    Temp = Rs.Fields(I)
    End If
    If Temp = True Then
    Temp = "x"
    ElseIf Temp = False Then
    Temp = ""
    End If
    Celija.Value = Temp
    Next I
Rs.MoveNext
Loop
If Red > 35 Then
Red = Red + 4
Else
Red = 39
End If
Set Celija = ExelO.Cells(Red, 2)
Temp = Forms![T_Pregled_DA_G]![Napomena]
Celija.Value = Temp
Set Celija = ExelO.Cells(1, 1)
Celija.Clear
Celija.Select
ExelO.Visible = True
Izlaz:
Exit Function
Greska:
End Function
Function Db_Putanja() As String
'------------------------------------------------
 'Ova funkcija pronalazi putanju postojee baze
 'Autor funkcije ZXZ
'------------------------------------------------
    Dim Db As Database, Putanja As String
    
    On Error Resume Next
    Set Db = DBEngine(0)(0)
    Putanja = Db.Name
    Do Until Right$(Putanja, 1) = "\"
        Putanja = Left$(Putanja, Len(Putanja) - 1)
    Loop
 
    Db_Putanja = Putanja
End Function