Prikazi cijelu temu 26.12.2012 15:33
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. If Red > 35 Then
  75. Red = Red + 4
  76. Else
  77. Red = 39
  78. End If
  79. Set Celija = ExelO.Cells(Red, 2)
  80. Temp = Forms![T_Pregled_DA_G]![Napomena]
  81. Celija.Value = Temp
  82. Set Celija = ExelO.Cells(1, 1)
  83. Celija.Clear
  84. Celija.Select
  85. ExelO.Visible = True
  86. Izlaz:
  87. Exit Function
  88. Greska:
  89. End Function
  90. Function Db_Putanja() As String
  91. '------------------------------------------------
  92. 'Ova funkcija pronalazi putanju postojee baze
  93. 'Autor funkcije ZXZ
  94. '------------------------------------------------
  95.    Dim Db As Database, Putanja As String
  96.    
  97.     On Error Resume Next
  98.     Set Db = DBEngine(0)(0)
  99.     Putanja = Db.Name
  100.     Do Until Right$(Putanja, 1) = "\"
  101.         Putanja = Left$(Putanja, Len(Putanja) - 1)
  102.     Loop
  103.  
  104.     Db_Putanja = Putanja
  105. End Function
Podrška samo putem foruma, jer samo tako i ostali imaju koristi od toga.