range objects / inserting a field(s) from access to excel range RRS feed

  • Question

  • I am having trouble putting a field into an excel range.

    Also when I set my "xldata" (which is the range object), is there a way I can somehow set my end range point dynamically depending on how many values are in the field? And if there is another way to do this, is the range object even necessary? 

    But my main concern is the "xldata.Range.Value = Forms("NI - Days passed form").RecordSource" line of code. How should I change it to make this work properly

    My code:

    Sub excelcreation()
    'Declare object variable
    Dim xlapp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlchart As Excel.Chart
    Dim xldata As Excel.Range

    'Set objects
    Set xlapp = CreateObject("Excel.Application")
    Set xlBook = xlapp.Workbooks.Open("C:\Users\HELLERLO\Documents\Logan.xlsx")
    Set xlSheet = xlBook.Worksheets.Item(1)
    Set xldata = xlSheet.Range("A1:A4")

    xldata.Range.Value = Forms("NI - Days passed form").RecordSource
    xlSheet.Application.Visible = True
    Friday, July 7, 2017 2:24 PM

All replies

  • Not the most elegant code, but I use this procedure to get access data to excel.  The function call requires a table/query name or a SQL Statement, and a title for the report.
    Function GenericExcelReport(sSelect As String, sTitle As String) As Boolean
    'On Error GoTo ErrGenericExcelReport
        GenericExcelReport = False
        Dim db As Database
        Dim rsGeneric As DAO.Recordset
        Set db = CurrentDb
        Set rsGeneric = db.OpenRecordset(sSelect, dbOpenDynaset, dbSeeChanges)
        Dim ColCount As Integer
        Dim col As Integer
        Dim row As Integer
        Dim oExcel As Excel.Application
        Dim oWB As Excel.Workbook
        Dim oWS As Excel.Worksheet
        'open the spreadsheet for editing
    'On Error GoTo Excel_EH
        If oExcel Is Nothing Then Set oExcel = New Excel.Application
        oExcel.Visible = True
        Set oWB = oExcel.Workbooks.Add
        Set oWS = oExcel.ActiveSheet
    'On Error GoTo ErrGenericExcelReport
        ColCount = rsGeneric.Fields.Count
        row = 1
        col = 0
        With oWS
            If (sTitle & "" <> "") Then row = row + 2       'set up for the title if there is one
            .Rows(row).Font.Bold = True
            'set up the Column Headings and
            Do While (col < ColCount)
                .Cells(row, col + 1).Value = rsGeneric.Fields(col).Name
                'check if this field type is Date/Time
                If rsGeneric.Fields(col).Type = 8 Then
                    'next line requires more checking, the property may not exist for each date field
                    'If (rsGeneric.Fields(col).Properties("Format") = "Short Date") then .Columns(col + 1).NumberFormat = "m/d/yyyy;@"
                    .Columns(col + 1).NumberFormat = "[$-409]yyyy-mm-dd"
                End If
                'check if this field type is Currency
                If rsGeneric.Fields(col).Type = 5 Then
                   .Columns(col + 1).NumberFormat = "$#,##0.00"
                End If
                col = col + 1
            'output the data
            If rsGeneric.EOF Then
                row = row + 1
                col = 0
                .Cells(row, col + 1).Value = "There are no records to display."
                .Range(.Cells(row, col + 1), .Cells(row, ColCount)).Merge
            End If
            Do While Not rsGeneric.EOF
                row = row + 1
                col = 0
                Do While (col < ColCount)
                    .Cells(row, col + 1).Value = rsGeneric.Fields(col)
                    col = col + 1
            .Cells.EntireRow.VerticalAlignment = xlTop
            If (sTitle & "" <> "") Then
                row = 1
                col = 0
                .Rows(row).Font.Bold = True
                .Cells(row, col + 1).Value = sTitle
                .Cells(row, col + 1).WrapText = False
                .Cells(row, col + 1).Font.Size = 14
            End If
        End With
        GenericExcelReport = True
    Exit Function
        MsgBox "An error occurred. Please close excel and try running the process again.", vbExclamation, "No Page Break Inserted"
    Exit Function
        MsgBox "An error occured while attempting to generate the report." & vbCrLf & Err.number & ": " & Err.Description
    Exit Function
    End Function


    Miriam Bizup Access MVP

    Friday, July 7, 2017 2:52 PM