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
For I = 0 To 17
Kolona = I + 1
Set Celija = ExelO.Cells(Red, Kolona)
Temp = Rs.Fields(I)
If Temp = True Then
Temp = "x"
ElseIf Temp = False Then
Temp = ""
End If
Celija.Value = Temp
Next I
Rs.MoveNext
Loop
Red = 39
Kolona = 2
Set Celija = ExelO.Cells(Red, Kolona)
Temp = Forms![T_Pregled_DA_G]![Napomena]
Celija.Value = Temp
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