Option Compare Database
Option Explicit
Global ExcelSheet As Object
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.Range(Kolona).Rows(Red).MergeCells = True
ExcelSheet.Application.Cells(Red, Kolona).Value = Podatak
PodatakPrije = Podatak
End If
RsSort.MoveNext
Loop

Rs.MoveFirst
Do While Not Rs.EOF
Podatak = Rs.Fields(1)
If Podatak <> PodatakPrije Then
Red = Red + 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
Podatak = Rs.Fields(1)
PodatakPrije = Podatak
End If
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 Functio