Function OtvoriExcel() Dim Db As Database Dim Rs As Recordset Dim RsSort As Recordset Dim Podatak, PodatakPrije Dim Red As Integer, Kolona As Integer Dim KolS() As String Dim X As Integer, N As Integer 'On Error GoTo OtvoriExcel_err 'PODACI IZ ACCESSA Set Db = CurrentDb Dim a, b Set Rs = Forms![frm_Davor].RecordsetClone Set ExcelSheet = CreateObject("Excel.Sheet") Red = 3 ExcelSheet.Application.Cells(Red, 1).Value = "Šifra" ExcelSheet.Application.Cells(Red, 2).Value = "Naziv" ExcelSheet.Application.Cells(Red, 3).Value = "Kom." Kolona = 2 Rs.Sort = "Rel" Set RsSort = Rs.OpenRecordset() X = Rs.RecordCount ReDim KolS(X + 3) RsSort.MoveFirst Do While Not RsSort.EOF Podatak = RsSort.Fields("Rel") If Podatak <> PodatakPrije Then Kolona = Kolona + 2 KolS(Kolona) = Podatak ExcelSheet.Application.Cells(Red, Kolona).Value = Podatak PodatakPrije = Podatak End If RsSort.MoveNext Loop Rs.MoveFirst Do While Not Rs.EOF Red = Red + 1 Podatak = Rs.Fields(1) ExcelSheet.Application.Cells(Red, 1).Value = Podatak Podatak = Rs.Fields(2) ExcelSheet.Application.Cells(Red, 2).Value = Podatak Podatak = Rs.Fields(3) ExcelSheet.Application.Cells(Red, 3).Value = Podatak For X = 4 To Kolona Step 2 If KolS(X) = Rs!Rel Then Podatak = Rs.Fields(5) ExcelSheet.Application.Cells(Red, X).Value = Podatak Podatak = Rs.Fields(6) ExcelSheet.Application.Cells(Red, X + 1).Value = Podatak End If Next X Rs.MoveNext Loop ExcelSheet.Application.Cells.EntireColumn.AutoFit Red = 1 Kolona = 1 Rs.MoveFirst Podatak = Rs.Fields(0) ExcelSheet.Application.Cells(Red, Kolona).Value = "PREGLED NA DAN " & Podatak ExcelSheet.Application.Visible = True OtvoriExcel_izl: Exit Function OtvoriExcel_err: MsgBox "Došlo je do greške", 48, "Greska" Resume OtvoriExcel_izl End Function