Prikazi cijelu temu 30.06.2015 08:07
pmiroslav Van mreze
Clan
Registrovan od:02.02.2009
Lokacija:Osijek


Predmet:Re: Prebacivanje sa access forme u excel.
Evo ti jedan kod možda pomogne.
PreuzmiIzvorni kôd (vbnet):
  1. Function Export2XLS(ByVal sQuery As String)
  2.     Dim oExcel          As Object
  3.     Dim oExcelWrkBk     As Object
  4.     Dim oExcelWrSht     As Object
  5.     Dim bExcelOpened    As Boolean
  6.     Dim Db              As DAO.Database
  7.     Dim Rs              As DAO.Recordset
  8.     Dim iCols           As Integer
  9.     Const xlCenter = -4108
  10.  
  11.     'Start Excel
  12.     On Error Resume Next
  13.     Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel
  14.  
  15.     If err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
  16.         err.Clear
  17.         On Error GoTo Error_Handler
  18.         Set oExcel = CreateObject("Excel.Application")
  19.         bExcelOpened = False
  20.     Else    'Excel was already running
  21.         bExcelOpened = True
  22.     End If
  23.     On Error GoTo Error_Handler
  24.     oExcel.ScreenUpdating = False
  25.     oExcel.Visible = False   'Keep Excel hidden until we are done with our manipulation
  26.     Set oExcelWrkBk = oExcel.Workbooks.Add()    'Start a new workbook
  27.     Set oExcelWrSht = oExcelWrkBk.Sheets(1)
  28.    
  29.  
  30.     'Open our SQL Statement, Table, Query
  31.     Set Db = CurrentDb
  32.     Set Rs = Db.OpenRecordset(sQuery, dbOpenSnapshot)
  33.     With Rs
  34.         If .RecordCount <> 0 Then
  35.             'Build our Header
  36.             For iCols = 0 To Rs.Fields.Count - 1
  37.                 oExcelWrSht.cells(1, iCols + 1).Value = Rs.Fields(iCols).Name
  38.             Next
  39.             With oExcelWrSht.Range(oExcelWrSht.cells(1, 1), _
  40.                                    oExcelWrSht.cells(1, Rs.Fields.Count))
  41.                 .Font.Bold = True
  42.                 .Font.ColorIndex = 2
  43.                 .Interior.ColorIndex = 1
  44.                 .HorizontalAlignment = xlCenter
  45.                
  46.             End With
  47.             oExcelWrSht.Range(oExcelWrSht.cells(1, 1), _
  48.                               oExcelWrSht.cells(1, Rs.Fields.Count)).columns.AutoFit    'Resize our Columns based on the headings
  49.             'Copy the data from our query into Excel
  50.             oExcelWrSht.Range("A2").CopyFromRecordset Rs
  51.             oExcelWrSht.Range("A1").Select  'Return to the top of the page
  52.         Else
  53.             MsgBox "Nema zapisa koji bi proizaÅ¡ao iz navedenog upita/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
  54.             GoTo Error_Handler_Exit
  55.         End If
  56.     End With
  57.  
  58. '        oExcelWrkBk.Close True, sFileName 'Save and close the generated workbook
  59. '
  60. '        'Close excel if is wasn't originally running
  61. '        If bExcelOpened = False Then
  62. '            oExcel.Quit
  63. '        End If
  64.  
  65. Error_Handler_Exit:
  66.     On Error Resume Next
  67.     oExcel.Visible = True   'Make excel visible to the user
  68.     Rs.Close
  69.     Set Rs = Nothing
  70.     Set Db = Nothing
  71.     Set oExcelWrSht = Nothing
  72.     Set oExcelWrkBk = Nothing
  73.     oExcel.ScreenUpdating = True
  74.     Set oExcel = Nothing
  75.     Exit Function
  76.  
  77. Error_Handler:
  78.     MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
  79.            "Error Number: " & err.Number & vbCrLf & _
  80.            "Error Source: Export2XLS" & vbCrLf & _
  81.            "Error Description: " & err.Description _
  82.            , vbOKOnly + vbCritical, "An Error has Occured!"
  83.     Resume Error_Handler_Exit
  84. End Function

Kopiraj ovo u neki modul i sa sa forme pozivaš sa

Call Export2XLS("Naziv tablice ili Querya koji se exportira")

Prilozi:
Export_u_Excel1.rar
Preuzimanja:210
Velicina datoteke:24.27 KB

Pozdrav
Ovaj post je ureden 1 puta. Posljednja izmjena 30.06.2015 08:09 od strane pmiroslav.