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.