Export to excel template or format page from Access

[adh123]

With thanks to previous help on here for creating the code below I am able to export quotes out of our access CRM.

Private Sub btnQuote_Click()

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstenq As DAO.Recordset
Dim rstquo As DAO.Recordset
Dim rstqlivat As DAO.Recordset
Dim rstqlinon As DAO.Recordset

Dim obExcel As Object
Dim intStart As Integer
Dim intCol As Integer
Dim iRow As Integer
Dim strDBPath As String
Dim strPictureName As String

strDBPath = CurrentProject.Path & "\"
strPictureName = "logo.jpg"

Set db = CurrentDb()

Set rst = db.OpenRecordset("SELECT * FROM tblCompany WHERE c_id = " & Me.c_id)
Set rstenq = db.OpenRecordset("SELECT * FROM tblEnquiries WHERE e_id = " & Me.e_id)
Set rstquo = db.OpenRecordset("SELECT * FROM tblQuote WHERE q_id = " & Me.q_id)
Set rstqlivat = db.OpenRecordset("SELECT tblQuoteLineItems.*, tblDrpSuppliers.supp_name FROM tblDrpSuppliers INNER JOIN tblQuoteLineItems ON tblDrpSuppliers.ID = tblQuoteLineItems.qli_supplier WHERE q_id = " & Me.q_id & " And qli_vatable = " & "-1 ORDER BY qli_item_category")
Set rstqlinon = db.OpenRecordset("SELECT tblQuoteLineItems.*, tblDrpSuppliers.supp_name FROM tblDrpSuppliers INNER JOIN tblQuoteLineItems ON tblDrpSuppliers.ID = tblQuoteLineItems.qli_supplier WHERE q_id = " & Me.q_id & " And qli_vatable = " & "0")
Set obExcel = CreateObject("Excel.Application")

MsgBox "logo = " & strDBPath & strPictureName

With obExcel
    .workbooks.Add

    'Incase sheet does not exist
    On Error Resume Next

    .Sheets("Sheet2").Delete
    .Sheets("Sheet3").Delete

    With obExcel
        If .activesheet.Name = "Sheet1" Then
            .activesheet.Name = strSheet_Name
            .cells.Font.Name = "Calibri"
            .cells.Font.Size = 11
            
            .columns("A").ColumnWidth = 200
            
            
            
            
            'Add column headers******************************************************
         
            .activesheet.cells(1, 2).Select
            .activesheet.pictures.Insert (strDBPath & strPictureName)
            .activesheet.cells(1, 1) = Me.cmbPerson.Column(2)
            .activesheet.cells(2, 1) = Me.c_name
            .activesheet.cells(3, 1) = rst!c_add1
            .activesheet.cells(4, 1) = rst!c_add2
            .activesheet.cells(5, 1) = rst!c_add3
            .activesheet.cells(6, 1) = rst!c_add4
            .activesheet.cells(7, 1) = rst!c_county
            .activesheet.cells(8, 1) = rst!c_postcode
            .activesheet.cells(10, 1) = "Enquiry:" & " " & rstenq!e_name
            .activesheet.cells(11, 1) = "Quote:" & " " & rstquo!q_name
            .activesheet.cells(13, 1).Font.Bold = True
            .activesheet.cells(13, 1) = "VATable items"
            .activesheet.cells(14, 1).Font.Bold = True
            .activesheet.cells(14, 1) = "Item"
            .activesheet.cells(14, 2).Font.Bold = True
            .activesheet.cells(14, 2) = "Qty in unit"
            .activesheet.cells(14, 3).Font.Bold = True
            .activesheet.cells(14, 3) = "No. of units"
            .activesheet.cells(14, 4).Font.Bold = True
            .activesheet.cells(14, 4) = "Cost"
            
            'Move last and first, cycle through records******************************************************

            rstqlivat.MoveLast
            rstqlivat.MoveFirst
            iRow = 15
            For i = 1 To rstqlivat.RecordCount
            
            'Add data ******************************************************
            
            .activesheet.cells(iRow, 1) = rstqlivat!qli_line_item
            .activesheet.cells(iRow, 2) = rstqlivat!qli_per
            .activesheet.cells(iRow, 3) = rstqlivat!qli_quantity
            .activesheet.cells(iRow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 4) = rstqlivat!qli_sell
                        
            iRow = iRow + 1
            rstqlivat.MoveNext
            
            Next i

            iRow = iRow + 2
            .activesheet.cells(iRow - 1, 1).Font.Bold = True
            .activesheet.cells(iRow - 1, 1) = "Non VATable items"
            
            .activesheet.cells(iRow - 1, 1).Font.Bold = True
            .activesheet.cells(iRow - 1, 1) = "Item"
            .activesheet.cells(iRow - 1, 2).Font.Bold = True
            .activesheet.cells(iRow - 1, 2) = "Qty in unit"
            .activesheet.cells(iRow - 1, 3).Font.Bold = True
            .activesheet.cells(iRow - 1, 3) = "No. of units"
            .activesheet.cells(iRow - 1, 4).Font.Bold = True
            .activesheet.cells(iRow - 1, 4) = "Cost"
                                    
            rstqlinon.MoveLast
            rstqlinon.MoveFirst
            
            For i = 1 To rstqlinon.RecordCount
            
            .activesheet.cells(iRow, 1) = rstqlinon!qli_line_item
            .activesheet.cells(iRow, 2) = rstqlinon!qli_per
            .activesheet.cells(iRow, 3) = rstqlinon!qli_quantity
            .activesheet.cells(iRow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 4) = rstqlinon!qli_sell
                        
            iRow = iRow + 1
            rstqlinon.MoveNext
            Next i
            
            'Add totals **********************************************
                        
            iRow = iRow + 1
            .activesheet.cells(iRow, 1).Font.Bold = True
            .activesheet.cells(iRow, 1) = "Subtotal"
            .activesheet.cells(iRow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 4) = Me.txtq_sell_subtotal
                        
            iRow = iRow + 1
            .activesheet.cells(iRow, 1).Font.Bold = True
            .activesheet.cells(iRow, 1) = "VAT"
            .activesheet.cells(iRow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 4) = Me.txtq_sell_vat
                        
            iRow = iRow + 1
            .activesheet.cells(iRow, 1).Font.Bold = True
            .activesheet.cells(iRow, 1) = "Cost"
            .activesheet.cells(iRow, 4).Font.Bold = True
            .activesheet.cells(iRow, 4).numberformat = "£#,##0.00"
            .activesheet.cells(iRow, 4) = Me.txtq_sell_total
                        
            'change size of columns in excel *******************************
            
            .columns("B:G").autofit
            .columns("A:A").ColumnWidth = 50
            
            
            
        End If

    End With

    .Sheets(1).Select

    'Make workbook visible
    .Visible = True

End With

'Close recordsets and database******************************************************

Set db = Nothing
Set obExcel = Nothing
Set rst = Nothing
Set rstenq = Nothing
Set rstquo = Nothing
Set rstqlivat = Nothing
Set rstqlinon = Nothing
Set rstSuppliers = Nothing
Set obExcel = Nothing

End Sub

Currently the staff here need to then move items around to make it fit on the page properly and so I have been looking for a way to simplify this.

I see 2 ways this could work:

1 - use a template and when creating a quote bring up a save as box. (How would I reference the template and open the save as dialog to a different folder to the one the template is located in?)
2 - As current but with entering formatting into the vba code above (how can I set the format of the excel page e.g. narrow margins and move the image to the top right corner - currently in a cell near but is offset )

Is there a suggested way for this to work as per the above or alternative method and some guidance to get me on the right lines?
The text in column A can sometimes be quite long and would need to appear on multiple lines after a certain number of characters - is there a way to do this?

Thanks very much in advance

 

[Rx_]

It depends (why yes.... I am a Contractor).
First of all, my preference is to create all "reports" in Excel. My preference is to code 100%, no templates.

Q: What is the environment this application will be used?
For example: My environment is Citrix (or Remote Terminal) so all virtual desktops use the exact same OS, Office version, and Network. The Excel output is saved on a Network Location, never on a workstation hard drive.
Will this application be run on one workstation? On many workstations? How consistent are the many workstations in terms of OS and MS Office versions?

In general: There are several recordsets. Excel put the first one at the top, counts the Record Count, then starts the next recordset.
My suggestions would be that the code creates the records from a SQL String.
Create the recordset SQLString = " Select orders123 as "Kansas Orders", qty as "Amount", .... more .... From TheOrderTable where orders123 = " & VariableStateIndexFromUserInput & "

Note two things:
The field names using AS can create the human readable column header. This eliminates the need to rename a individual cell in the header later. It is also self documentation.
The Where statement allows an Access user interface to let the user enter specific information. It doesn't have to be one thing, it can be several things.

If trying to create more of a Form or Statement looking output, my preference would be to write a vba Excel template type form rather than use a Template.
An example of this would be a Medical medication daily form for Nurses.
Look up the term Named Ranges in Excel.
A Named Range can be addressed by vba code.
Lets say that a Named Range was in Cell D5.
Then, a recordset of 10 records was Insereted in row 3.
The Named Range would just move down 10 rows. The named range could still be filled in by referencing its name.

Look up some of my Rx_ Excel VBA post with SaveAs
I think there is some code to take the Excel variable object (my standard name is ObjXL) and SaveAs - to some location.
My formula take a network location, the User's Network ID, the Report Name, the date/time. If a folder doesn't exist, it creates the folder. Then it files each report in the user's report name folder and assigns a unique date stamp on the folder. It automates the report filing.

This site has an Excel Forum. Besides me, there are some excellent people there who can also assist with Excel vba being called from Access. At the point you can upload a tiny Access DB with some sample tables and code, you might even get something more.
For example, this is a small query that joins Oracle, SQL Server and Access DB - the AS statements and user supplied filter bring over the column names and Where requirements:

Function SQLTextForRegMatchNav(ID_Area As String) As String
    strSQL = ""
    strSQL = strSQL & "SELECT Wells_Areas.Area, Wells_PAD_Name.PadNameFinal AS [Pad Name], Wells.Well_Name AS [Reg Name], Navigator.WELL_NAME AS [Nav Name], " & _
                      "Wells_Status1.Status1 AS [Well Status], States.State_Abrv AS [Reg ST], Navigator.STATE_ABBRV AS [Nav ST], tblWells_County.County AS [Reg County], " & _
                      "Navigator.COUNTY_NAME AS [Nav County], Navigator.OPERATOR_NAME AS [Nav Operator], Navigator.CANCELLED_FL AS [Nav Cancel], Navigator.ACTIVE_FL AS [Nav Active], " & _
                      "Format([DATE_CREATED],'Short Date') AS [Nav Dt Create], Navigator.EOG_LEASE_NO AS [Nav Lease No], Navigator.EOG_LEASE_SUFFIX AS [Nav Lease Suff], " & _
                      "Wells.ID_Wells AS [Reg Well ID], Navigator.Well_ID AS [Nav Well ID], Wells_Areas.ID_Area "
    strSQL = strSQL & "FROM ((((((Wells LEFT JOIN States ON Wells.ID_State = States.ID_State) LEFT JOIN tblWells_County ON Wells.ID_County = tblWells_County.ID_County) " & _
                      "INNER JOIN NV_RegToNavLink ON Wells.ID_Wells = NV_RegToNavLink.REG_ID_Wells) INNER JOIN Navigator ON NV_RegToNavLink.NAV_Well_ID = Navigator.Well_ID) " & _
                      "LEFT JOIN Wells_Areas ON Wells.ID_Area = Wells_Areas.ID_Area) LEFT JOIN Wells_Status1 ON Wells.ID_WellsStatus1 = Wells_Status1.ID_WellStatus1) " & _
                      "LEFT JOIN Wells_PAD_Name ON Wells.ID_PAD_Name = Wells_PAD_Name.ID_PAD_Name "
    strSQL = strSQL & "WHERE (((Wells.Activity)='A') AND ((Wells_Areas.ID_Area) " & ID_Area & ")) "
    strSQL = strSQL & "ORDER BY Wells_Areas.Area, Wells.WName, IIf(IsNumeric([WNumber])=True,CLng([WNumber]),Null), IIf(IsNumeric([WSection])=True,CLng([WSection]),Null), Wells.WDesc;"   
    SQLTextForRegMatchNav = strSQL   
    'Debug.Print strSQL ' uncomment to get SQL string and Paste in a blank Query Design (SQL mode) to debug. 

End Function

This SQL String is used later to create a recordset
Set rsDataNav_RegMatchesNav = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly + dbSeeChanges)

If no records are returned, let the user know but don't run the rest of the code:

    If rsDataNav_RegMatchesNav.RecordCount < 1 Then
        Debug.Print "Data returned this many records " & rsDataNav_RegMatchesNav.RecordCount
        MsgBox "There are no records for the selected criteria", vbOKOnly, "No Records - No Report"
        Nav_RegMatchesNav = True
        Exit Function
    End If

Rather than post the first record at cell A1, leave about 5 rows before adding the data.

    intRowPos = 6 ' Sets starting Row for data in Excel - reference fields to this
        
    objXL.DisplayAlerts = False ' Turn off Display Alerts - turn back on later
    objXL.Worksheets(intWorksheetNum).Cells(intRowPos, 1).CopyFromRecordset rsDataNav_RegMatchesNav

    intMaxRecordCount = rsDataNav_RegMatchesNav.RecordCount - 1 ' - record the max rows returned in Excel formatting later

Now, go back and harvest the SQL - AS header information

' ------- Create Header in new Excel based on Query
    intMaxheaderColCount = rsDataNav_RegMatchesNav.Fields.count - 1
    
    For intHeaderColCount = 0 To intMaxheaderColCount
        If Left(rsDataNav_RegMatchesNav.Fields(intMaxheaderColCount).Name, 3) <> "xxx" Then  'Future use - adding xxx in cross tab queries for fields to exclude
            objXL.Worksheets(intWorksheetNum).Cells(intRowPos - 1, intHeaderColCount + 1) = rsDataNav_RegMatchesNav.Fields(intHeaderColCount).Name    ' Relative to intRowPos
        End If
    Next intHeaderColCount
    'Debug.Print "Columns created count is " & intHeaderColCount

This prevented going back, cell by cell to change a name in the header.
Note, how this process uses relative references and goes back to the top