Prikazi cijelu temu 08.12.2012 13:09
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: export u excel (redosled kao u reportu)
Uf sinoc nisam uradio.
Imao sam goste.
Evo ovako.
Imas zakaceni file qb.dll.
To je u stvari tvoja templata u exelu.
na formi T_Pregled_Da_G napravi jedan komandni taster i daj mu ime exel
Na on klik tog tastera stavi ovaj kod:
PreuzmiIzvorni kôd (Visual Basic):
  1. Private Sub Exel_Click()
  2. Call ExelI
  3. End Sub

Ovaj kod ispod stavi u neki modul (Napr. module1).
PreuzmiIzvorni kôd (Visual Basic):
  1. Function ExelI()
  2. Dim Db As Database
  3. Dim Rs As Recordset
  4. Dim Temp
  5. Dim ExelO As Object
  6. Dim Celija As Object
  7. Dim Red As Integer, Kolona As Integer
  8. Dim I As Integer
  9.  
  10. On Error GoTo Greska:
  11. Set Db = CurrentDb()
  12. Temp = Db_Putanja
  13. Set Rs = Forms![T_Pregled_DA_G]![T_Pregled_DA_P subform].Form.RecordsetClone
  14. Set ExelO = CreateObject("excel.Application")
  15. FileCopy Temp & "qb.dll", Temp & "Pregled.xls"
  16. ExelO.Workbooks.Open (Temp & "Pregled.xls")
  17.  
  18. Red = 5
  19. Kolona = 3
  20. Set Celija = ExelO.Cells(Red, Kolona)
  21. Temp = Forms![T_Pregled_DA_G]![Referent_prodaje].Column(1)
  22. Celija.Value = Temp
  23. Red = 6
  24. Kolona = 3
  25. Set Celija = ExelO.Cells(Red, Kolona)
  26. Temp = Forms![T_Pregled_DA_G]![Datum]
  27. Celija.Value = Temp
  28. Red = 7
  29. Kolona = 3
  30. Set Celija = ExelO.Cells(Red, Kolona)
  31. Temp = Forms![T_Pregled_DA_G]![Pocetak_rada]
  32. Celija.Value = Temp
  33. Red = 8
  34. Kolona = 3
  35. Set Celija = ExelO.Cells(Red, Kolona)
  36. Temp = Forms![T_Pregled_DA_G]![Zavrsetak_rada]
  37. Celija.Value = Temp
  38. Red = 9
  39. Kolona = 3
  40. Set Celija = ExelO.Cells(Red, Kolona)
  41. Temp = Forms![T_Pregled_DA_G]![Dnevna_kilometraza]
  42. Celija.Value = Temp
  43. Red = 10
  44. Kolona = 3
  45. Set Celija = ExelO.Cells(Red, Kolona)
  46. Temp = Forms![T_Pregled_DA_G]![Broj_posjecenih_DM]
  47. Celija.Value = Temp
  48. Red = 15
  49. Rs.MoveFirst
  50. Do While Not Rs.EOF
  51. Red = Red + 1
  52.     For I = 0 To 17
  53.     Kolona = I + 1
  54.     Set Celija = ExelO.Cells(Red, Kolona)
  55.     Temp = Rs.Fields(I)
  56.     If Temp = True Then
  57.     Temp = "x"
  58.     ElseIf Temp = False Then
  59.     Temp = ""
  60.     End If
  61.     Celija.Value = Temp
  62.     Next I
  63. Rs.MoveNext
  64. Loop
  65. Red = 39
  66. Kolona = 2
  67. Set Celija = ExelO.Cells(Red, Kolona)
  68. Temp = Forms![T_Pregled_DA_G]![Napomena]
  69. Celija.Value = Temp
  70. ExelO.Visible = True
  71. Izlaz:
  72. Exit Function
  73. Greska:
  74. End Function
  75. Function Db_Putanja() As String
  76. '------------------------------------------------
  77. 'Ova funkcija pronalazi putanju postojee baze
  78. 'Autor funkcije ZXZ
  79. '------------------------------------------------
  80.    Dim Db As Database, Putanja As String
  81.    
  82.     On Error Resume Next
  83.     Set Db = DBEngine(0)(0)
  84.     Putanja = Db.Name
  85.     Do Until Right$(Putanja, 1) = "\"
  86.         Putanja = Left$(Putanja, Len(Putanja) - 1)
  87.     Loop
  88.  
  89.     Db_Putanja = Putanja
  90. End Function


Prilozi:
qb.zip
Preuzimanja:227
Velicina datoteke:7.68 KB

Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.