[AccessD] Access + Excel Questions

Rocky Smolin rockysmolin2 at gmail.com
Mon Sep 20 11:28:58 CDT 2021


Arthur:

Here's some code that creates an XL spreadsheet and pushes data out to the
sheet with formatting.  Following that is some code that puts some summary
lines on the spreadsheet. I found that I did not need to know how to
manipulate the spreadsheet from the Access VBA module. I just used the
macro recorder in Excel to do what I wanted, and then cribbed out the xcode
that the macro recorder created.

HTH

Rocky

*****************************
Dim objXLApp As Excel.Application
Dim objXLBook As Excel.Workbook
Dim objXLWS As Excel.Worksheet

' Create Excel Spreadsheet
Set objXLApp = New Excel.Application

'Set objXLApp = objXLBook.Parent
objXLApp.Workbooks.Add
Set objXLWS = objXLApp.ActiveSheet

'write it out - first 3 columns first, the the rest in account number order
For intThisCol = 1 To 3
    For intThisRow = 1 To intRows
            objXLWS.Cells(intThisRow, intThisCol) = Aray(intThisRow,
intThisCol)
    Next intThisRow
Next intThisCol

'Now write out the rest of the columns in account number order
strCurrentAccount = "00000"
For intColOut = 4 To intCols - 1
    intThisCol = GetNextAccount

    For intThisRow = 1 To intRows
        objXLWS.Cells(intThisRow, intColOut) = Aray(intThisRow, intThisCol)
    Next intThisRow

    If intThisCol = 4 Then
        For intThisRow = intTotalRow + 1 To intRows
            objXLWS.Cells(intThisRow, 4) = Aray(intThisRow, intThisCol)
        Next intThisRow
    End If

Next intColOut

' Last write out the last 'Net' column
For intThisRow = 1 To intRows
    objXLWS.Cells(intThisRow, intCols) = Aray(intThisRow, intCols)
Next intThisRow

' Bottom Stuff
objXLWS.Cells(intRows, 3) = "Total 10400 minus Total CreditCards"
objXLWS.Cells(intRows, 4) = sglTotal10400 - sglTotalCC
intRows = intRows + 2
objXLWS.Cells(intRows, 3) = "Total 10610 Debits"
For intI = 1 To intCols
    If Aray(2, intI) = "10610" Then
        objXLWS.Cells(intRows, 6) = Aray(intTotalRow, intI)

    End If
Next intI
intRows = intRows + 2
For intThisCol = 1 To intCols
    If Aray(2, intThisCol) = "10420" Then Exit For
Next intThisCol

objXLWS.Cells(intRows, 3) = "Total 10420 Debits"
objXLWS.Cells(intRows, 5) = Aray(intTotalRow, intThisCol)
For intI = intTotalRow + 2 To intTotalRow + 5
    objXLWS.Cells(intRows, 5) = objXLWS.Cells(intRows, 5) -
Nz(objXLWS.Cells(intI, 5))
Next intI

' Format the spreadsheet

' Print Gridlines
    With objXLApp.ActiveSheet.PageSetup
        .PrintGridlines = True
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 2
        .FitToPagesTall = 1
    End With

' Currency format for numbers
    For intThisCol = 4 To intCols
        objXLWS.Columns(intThisCol).NumberFormat = "0.00_);[Red](0.00)"
    Next intThisCol
    objXLWS.Rows(2).NumberFormat = "#####"

' Format row 1 & 2
    objXLWS.Rows(1).RowHeight = 50
    objXLWS.Rows(1).WrapText = True
    objXLWS.Rows(1).HorizontalAlignment = xlRight
    objXLWS.Cells(2, intCols).HorizontalAlignment = xlRight
    objXLWS.Rows(1).Font.ColorIndex = 11
    objXLWS.Rows(2).Font.ColorIndex = 11
    objXLWS.Cells(1, 1).HorizontalAlignment = xlCenter
    objXLWS.Cells(1, 1).VerticalAlignment = xlCenter

' Format Bold Some Rows
    objXLWS.Rows(1).Font.Bold = True
    objXLWS.Rows(2).Font.Bold = True
    objXLWS.Rows(intTotalRow).Font.Bold = True

' Column Widths
    objXLWS.Columns.EntireColumn.AutoFit

' Make the spreadsheet visible
    objXLApp.Visible = True

***********************************
Private Sub cmdBoatSummaryToExcel_Click()

Set db = CurrentDb
strFrontEndPath = db.Name
Do While Right(strFrontEndPath, 1) <> "\"
    strFrontEndPath = Left(strFrontEndPath, Len(strFrontEndPath) - 1)
Loop
On Error Resume Next
Kill strFrontEndPath & "BoatSummary.XLS"
On Error GoTo 0

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"qryBoatSummaryExport", strFrontEndPath & "BoatSummary", True

' Object variables for Automation stuff
Dim objXLApp As Excel.Application
Dim objXLBook As Excel.Workbook
Dim objXLWS As Excel.Worksheet

Set objXLApp = New Excel.Application
objXLApp.Workbooks.Open strFrontEndPath & "BoatSummary.xls"
Set objXLWS = objXLApp.ActiveSheet
objXLApp.Range("A1").Select
objXLApp.Selection.EntireRow.Insert
objXLApp.Selection.EntireRow.Insert
objXLApp.Cells(1, 1) = "Boat: " & Me.cboBoatSummaryBoat.Column(1) & "
 From: " & Me.txtBoatSummaryStartDate _
    & " Through: " & Me.txtBoatSummaryEndDate
objXLApp.ActiveWorkbook.Save
objXLApp.ActiveWorkbook.Close True
objXLApp.Quit
Set objXLApp = Nothing

MsgBox "Boat Summary exported to  " & strFrontEndPath & "BoatSummary",
vbExclamation

End Sub
***********************************
On Sun, Sep 19, 2021 at 3:13 PM Arthur Fuller <fuller.artful at gmail.com>
wrote:

> I have an Access app (actually I only wrote part of it, and the client has
> asked for a couple of enhancements. I'm not sure how to handle them/
>
> Within Access, I have code that creates a RecordSet and then calls Excel
> and sends the ReocrdSet there, but it arrives bare-bones. Withing Access,
> the appropriate button generates both an Access report and exports the data
> to Excel. present the
> the form on which the button lives contains some data that I would like to
> export to the Excel workbook 00 simple things like the CompanyID, the
> ProjectID, etc. I would like to send these values into the generated Excel
> file, and present them as a Header to the raw spreadsheet data. Ideally, I
> would like also to present the Recordset rows beneath a header that
> displays CompanyID and ProjectID.
> I've heard and read that an Excel template might do the trick. I have been
> doing some reading on this, but I'm not even confident that I know how to
> create a template, let alone address the cells in the header.
> Let's say the desired header looks like this:
> A1: "Company:"
> B1: CompanyID value set from Access
> A2: "Project"
> B2: ProjectID value set from Access
>
> Beneath this header are the rows that come from an Access RecordSet. Thet's
> the only part I have that works.
>
> My reading suggest that I should create a template (perhaps with two named
> ranges (CompanyID and ProjectID) and then address each of them
> directly from Access, presumably using the Range thing. Assuming that I get
> past these hurdles, then I need to tell Access to send the Recordset tp A3,
> and then tell Excel to set the RecordSet headeeers to bold, and size the
> columns according to the width of the column names.
>
> Frankly I haven't much of a clue how to control Excel from Access. My
> reading has led to the discovery of an Excel function called
> CopyFromRecordSet(), but don't know how to use it. Hell, I'm not even sure
> how to create an Excel temple, or how to a) load it from Access, and b)
> generate the XLS filename from within Access (which having loaded the
> template, the resultant file should receive its name from Access, so the
> whole process is invisible to the client and his users.
>
> I've been mostlyy retired for seceral years, and forgotten almost
> everything I knew, so reminders, suggestions, examples, and corrections to
> my strategy are invited.
>
> As Michael Corleone told his wife, "I keep trying to get out, but they keep
> dragging me back in." Things could be worse: they could try to assassinate
> me "In My Home! In My Home!"
>
> (You may conjecture that I love Godfather One and especially Two.)
>
> --
> Arthur
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> https://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>


More information about the AccessD mailing list