Prikazi cijelu temu 22.12.2012 15:34
zxz Van mreze
Administrator
Registrovan od:03.02.2009
Lokacija:Tuzla


Predmet:Re: export u excel (redosled kao u reportu)
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. If Red > 35 Then
  53. ExelO.Rows("35:35").copy
  54. ExelO.Rows(Red & ":" & Red).Insert Shift:=xlDown
  55. End If
  56. Kolona = 2
  57.     For I = 0 To 17
  58.     Kolona = I + 1
  59.     Set Celija = ExelO.Cells(Red, Kolona)
  60.     If Kolona = 1 Then
  61.     Temp = Red - 15
  62.     Else
  63.     Temp = Rs.Fields(I)
  64.     End If
  65.     If Temp = True Then
  66.     Temp = "x"
  67.     ElseIf Temp = False Then
  68.     Temp = ""
  69.     End If
  70.     Celija.Value = Temp
  71.     Next I
  72. Rs.MoveNext
  73. Loop
  74.  
  75. Red = Red + 4
  76. Set Celija = ExelO.Cells(Red, 2)
  77. Temp = Forms![T_Pregled_DA_G]![Napomena]
  78. Celija.Value = Temp
  79. Set Celija = ExelO.Cells(1, 1)
  80. Celija.Clear
  81. Celija.Select
  82. ExelO.Visible = True
  83. Izlaz:
  84. Exit Function
  85. Greska:
  86. End Function
  87. Function Db_Putanja() As String
  88. '------------------------------------------------
  89. 'Ova funkcija pronalazi putanju postojee baze
  90. 'Autor funkcije ZXZ
  91. '------------------------------------------------
  92.    Dim Db As Database, Putanja As String
  93.    
  94.     On Error Resume Next
  95.     Set Db = DBEngine(0)(0)
  96.     Putanja = Db.Name
  97.     Do Until Right$(Putanja, 1) = "\"
  98.         Putanja = Left$(Putanja, Len(Putanja) - 1)
  99.     Loop
  100.  
  101.     Db_Putanja = Putanja
  102. End Function
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.