none
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
    
    
        DoEvents
        
        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
            Loop
            
            '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
                Loop
                            
                rsGeneric.MoveNext
            Loop
            
        
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .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
    
    Excel_EH:
        DoEvents
        DoEvents
        MsgBox "An error occurred. Please close excel and try running the process again.", vbExclamation, "No Page Break Inserted"
    Exit Function
    
    ErrGenericExcelReport:
        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