Predmet:Re: export podataka iz pivot access u excel tabelu
Evo.
Proceduru moras pozvati sa forme pivot.
Naime forma mora biti otvorena radi uslova koji si stavio.
PreuzmiIzvorni kôd (Visual Basic):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
Podrska samo putem foruma, jer samo tako i ostali imaju koristi od toga.