Range in Excel from Access

[ctr1085]

Is there a way to set a "Range" from vb code in Access? I use ranges a lot in excel to create formulas and I cannot figure out how to do this from access when exporting data to excel. Any information would be appreciated.

 

[checoturco]

I don´t know if this helps you but i use this command to import data from excel

DoCmd.TransferSpreadsheet acImport, 8, "tempsuc", txtCaminhosuc, True, "A:K"

the range is "A:K"

and this cod to export to excel

Set MyExcelInstance = New Excel.Application
Set Myworkbook = MyExcelInstance.Workbooks.Open("" & PathFile)
Set ws = Myworkbook.Worksheets("Aprentro")
....
....

Set calcsheet = New ADODB.Recordset
calcsheet.Open "SELECT brig,totape,totdespers,totreuts," _
& "flag,zona from TotalBrigRen;", cnch5, adOpenDynamic
ws.Cells(8, 1).CopyFromRecordset calcsheet, , 6

the 6 is the number of columns to export ( from A to F in Excel)

checo

 

[ctr1085]

Checo,

I'm not having a problem transfering the data to excel. What I'm trying to accomplish is set ranges to calculate formulas in excel from Access. In excel I can declare ranges. Access does not allow this from what I have seen.

Dim prngA as Range << Excel only?

Here's the code I'm using to export. I have been having trouble using some of the functionality from access, which is in Excel. I cannot figure out how to align cells from access, export headers or set ranges in excel for formulas.

Private Sub btnView_Click()
  Dim DB As DAO.Database, RS As DAO.Recordset
  Dim objXL As Object, objCreateWkb As Object, objActiveWkb As Object, objSheet As Object
  Dim pblnAllDates As Boolean
  Dim plngFromDate As Long
  Dim plngRecordCount As Long
  Dim plngToDate As Long
  Dim pstrRsSql As String
    'Validation
    If chkRevenueDateAll = 0 And (IsNull(txtRevenueDateFrom) Or IsNull(txtRevenueDateTo)) Then
      MsgBox "Please make a valid Revenue Date selection.", vbCritical, "Revenue Date Error"
      Exit Sub
    End If 'chkRevenueDateAll = 0 And IsNull(txtRevenueDateFrom)
    'SQL Statement
    pstrRsSql = "SELECT A.PARENT, B.IND, B.SBG, B.IND_Bonus, B.SBG_Bonus, B.Licensing, B.IND_Misc_Exp, B.SBG_Misc_Exp, B.Other_Rec, B.Unknown " _
      & "FROM (SELECT DISTINCT Parent_Carrier_Name as PARENT FROM tblStmt_Tracking) AS A " _
      & "LEFT JOIN " _
      & "(SELECT tblStmt_Tracking.Parent_Carrier_Name AS PARENT, Sum(tblStmt_Tracking.IND_Amount) AS IND, " _
        & "Sum(tblStmt_Tracking.SBG_Amount) AS SBG, Sum(tblStmt_Tracking.IND_Bonus_Amount) AS IND_Bonus, " _
        & "Sum(tblStmt_Tracking.SBG_Bonus_Amount) AS SBG_Bonus, Sum(tblStmt_Tracking.Licensing_Fees) AS Licensing, " _
        & "Sum(tblStmt_Tracking.IND_Misc_Expenses) AS IND_Misc_Exp, Sum(tblStmt_Tracking.SBG_Misc_Expenses) AS SBG_Misc_Exp, " _
        & "Sum(tblStmt_Tracking.Other_Receivables) AS Other_Rec, Sum(tblStmt_Tracking.Unknown_Amount) AS Unknown " _
      & "FROM tblStmt_Tracking LEFT JOIN tblCheck_Log ON tblStmt_Tracking.Check_Assignment_ID = tblCheck_Log.Check_Assignment_ID " _
    'SQL All Checks Selection
    If chkRevenueDateAll = -1 Then
      pblnAllDates = True
    Else
      plngFromDate = txtRevenueDateFrom
      plngToDate = txtRevenueDateTo
      pstrRsSql = pstrRsSql _
        & "WHERE tblCheck_Log.Revenue_Date BETWEEN " & plngFromDate & " And " & plngToDate & " "
    End If 'chkRevenueDateAll = -1
    pstrRsSql = pstrRsSql & "GROUP BY tblStmt_Tracking.Parent_Carrier_Name) AS B ON A.PARENT = B.PARENT " _
    'SQL Parent Carrier Selection
    If cmbParentCarrier <> "* (All Carriers)" Then
      If pblnAllDates Then
        pstrRsSql = pstrRsSql _
          & "WHERE A.PARENT = '" & cmbParentCarrier & "' "
      Else
        pstrRsSql = pstrRsSql _
          & "AND A.PARENT = '" & cmbParentCarrier & "' "
      End If 'pblnAllDates
    End If 'cmbParentCarrier <> "* (All Carriers)"
    'Finish SQL Statement
    pstrRsSql = pstrRsSql _
      & "ORDER BY A.PARENT;"
    'Update Query
    CurrentDb.QueryDefs("REPORT_STMT_Breakout").SQL = pstrRsSql
    'Set Database
    Set DB = CurrentDb
    'Set Excel Application
    Set objXL = CreateObject("Excel.Application")
    Set objCreateWkb = objXL.Workbooks.Add 'Add Workbook
    Set objActiveWkb = objXL.Application.ActiveWorkBook
    objXL.Visible = True
    objActiveWkb.Sheets.Add
    objActiveWkb.WorkSheets(1).Name = "Breakout"
    Set RS = DB.OpenRecordset("REPORT_STMT_Breakout")
    RS.MoveLast
    plngRecordCount = RS.RecordCount
    RS.MoveFirst
    'Remove sheets
    For Each objSheet In objActiveWkb.WorkSheets
      If objSheet.Name <> "Breakout" Then
        objXL.DisplayAlerts = False
        objSheet.Delete
        objXL.DisplayAlerts = True
      End If 'sheet.Name <> "Breakout"
    Next objSheet
    Set objSheet = objActiveWkb.WorkSheets("Breakout")
    objSheet.Cells(1, 1).Value = "Report Run Date:"
    objSheet.Cells(1, 2).Value = Format(Now(), "m/d/yy h:mm:ss")
    objSheet.Cells(2, 1).Value = "Date Range:"
    If pblnAllDates Then
      objSheet.Cells(2, 2).Value = "* (All Dates)"
    Else
      objSheet.Cells(2, 2).Value = Format(plngFromDate, "mm/dd/yyyy")
      objSheet.Cells(2, 3).Value = Format(plngToDate, "mm/dd/yyyy")
    End If 'pblnAllDates
    objSheet.Cells(3, 1).Value = "Parent_Carrier_Name"
    objSheet.Cells(3, 2).Value = "IND_Amount"
    objSheet.Cells(3, 3).Value = "SBG_Amount"
    objSheet.Cells(3, 4).Value = "IND_Bonus_Amount"
    objSheet.Cells(3, 5).Value = "SBG_Bonus_Amount"
    objSheet.Cells(3, 6).Value = "Licensing_Fees"
    objSheet.Cells(3, 7).Value = "IND_Misc_Expenses"
    objSheet.Cells(3, 8).Value = "SBG_Misc_Expenses"
    objSheet.Cells(3, 9).Value = "Other_Receivables"
    objSheet.Cells(3, 10).Value = "Unknown_Amount"
    objSheet.Cells(4, 1).CopyFromRecordset RS
    With objSheet.Range("A3:J3")
      .Interior.ColorIndex = 35
      .Borders.Linestyle = xlContinuous
      .Borders.ColorIndex = xlAutomatic
    End With
    objSheet.Range("B4:J" & plngRecordCount + 3).Style = "Currency"
    objSheet.Range("A:A").EntireColumn.AutoFit
    objSheet.Range("B:J").ColumnWidth = 15
    objSheet.Range("B4").Activate
    objXL.ActiveWindow.FreezePanes = True
    objSheet.Range("A1").SELECT
    Set objActiveWkb = Nothing
    Set objCreateWkb = Nothing
    Set objXL = Nothing
    RS.Close
    DB.Close
    Set RS = Nothing
    Set DB = Nothing
End Sub 'btnView_Click

 

[workmad3]

add the Microsoft Excel Object library into you access project, and it should let you create excel ranges. It will probably be safest to use the full name when doing it though, so Excel.Range rather than just Range.

Hope this helps