Temat: Export za pomocą VBA do Excela z formatowa treści

Witam.

Udaje mi się exportować dane z formularza do pliku Excela lecz nie przenoszą się rekordy z poprawnym formatowaniem, które posiadają maskę wprowadzania lub są listami rozwijanymi o źródle w innej tabeli. Exportowane jest tylko ID (czyli np. 1, 2, 3) danego rekordu a w tabeli bazy danych widoczny jest prawidłowo. Funkcja uruchamiana jest z poziomu formularza. W formularzu formatowanie również jest widoczne poprawnie.

Z góry dziękuję za pomoc.
Pozdrawiam

Wklejam kod:

Function Export2XLSFillForm(sXlsFile As String, sQuery As String)

    Dim oExcel          As Object

    Dim oExcelWrkBk     As Object

    Dim oExcelWrSht     As Object

    Dim bExcelOpened    As Boolean

    Dim db              As DAO.Database

    Dim rs              As DAO.Recordset

    Dim iCols           As Integer

    Const xlCenter = -4108



    'Start Excel

    On Error Resume Next

    Set oExcel = GetObject(, "Excel.Application")    



    If Err.Number <> 0 Then    

        Err.Clear

        On Error GoTo Error_Handler

        Set oExcel = CreateObject("excel.application")

        bExcelOpened = False

    Else    'Excel was already running

        bExcelOpened = True

    End If

    On Error GoTo Error_Handler

    oExcel.ScreenUpdating = False

    oExcel.Visible = True   'Keep Excel hidden until we are done with our manipulation

    Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)

    DoEvents

    Set oExcelWrSht = oExcelWrkBk.Sheets(1)

    oExcelWrSht.Activate



    'Open our SQL Statement, Table, Query

    Set db = CurrentDb

    Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)

    With rs

        If .RecordCount <> 0 Then

            .MoveFirst

            oExcelWrSht.Range("CT19").Value = ![IMIE]

            oExcelWrSht.Range("CX34").Value = ![NAZWISKO]

            oExcelWrSht.Range("DC36").Value = ![KOD_POCZTOWY]   '<----LISTA ROZWIJANA / ŹRÓDŁO Z INNEJ TABELI

            

            

            

            oExcelWrSht.Range("A1").Select  'Return to the top of the page

        Else

            MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"

            GoTo Error_Handler_Exit

        End If

    End With



    '    oExcelWrkBk.Close True, sFileName 'Save and close the generated workbook



    '    'Close excel if is wasn't originally running

    '    If bExcelOpened = False Then

    '        oExcel.Quit

    '    End If



Error_Handler_Exit:

    On Error Resume Next

    oExcel.Visible = True   'Make excel visible to the user

    rs.Close

    Set rs = Nothing

    Set db = Nothing

    Set oExcelWrSht = Nothing

    Set oExcelWrkBk = Nothing

    oExcel.ScreenUpdating = True

    Set oExcel = Nothing

    Exit Function



Error_Handler:

    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _

           "Error Number: " & Err.Number & vbCrLf & _

           "Error Source: Export2XLSFillForm" & vbCrLf & _

           "Error Description: " & Err.Description _

           , vbOKOnly + vbCritical, "An Error has Occured!"

    Resume Error_Handler_Exit

End Function

Temat: Export za pomocą VBA do Excela z formatowa treści

Podbijam temat