Microsoft Access 2013 Using VBA to create formatted Excel Spreadsheet

Posted on 2014-04-30
Last Modified: 2014-05-30
I have a query qryofrecordsexcel. I want to create an excel spreadsheet in a specific folder from this query. I will have to center certain fields and left justify certain fields. I will need conditional formating to include if status is closed = Grey will be the background color. If it is open and a response has been sent ([Corresp Date] not null)it should be blue. If we have no response from requester([Current Stage] =No response  it should be Pink. This report will be generated daily. I use Do cmd transferr spreadsheet acExport now to generate the file now but really need to get this format to work. I will need step by step instructions on this one. Thanks for any help.
Question by:marlind605
LVL 34

Expert Comment

ID: 40033022
I don't have any code handy that will help you but you can figure out some stuff for yourself by using the macro recorder in Excel.   That's how I figured it out originally.

Open a spreadsheet and put in some data that looks like what you will be adding.  Then turn on the macro recorder and go through the motions of formatting a cell to have the attributes you want.  Stop the recorder and examine the code that was generated.  You can copy that code and with a minor tweak to how the workbook is referenced, run it from Access.  If you still need help, I'll post a sample later this evening.

We will also need to know if you are poking values into individual cells or if you are appending many rows and then need to loop through them looking for situations that will control the formatting.

Sometimes, if you are comfortable doing this with Excel, you can create an Excel macro to do all the formatting.  Then you append the data from Access and run the Excel macro to do the formatting.

Author Comment

ID: 40033214
Thanks. I will try it.

Author Comment

ID: 40033313
Unfortunately I know access a lot but not Excel. This will be a new database everyday not sure how to get a new excel to create a new macro. Can the macro be in another spreadsheet? But in the mean time I am going to try something with your original idea.

Author Comment

ID: 40033373
My initial macro run didn't do anything but I found this and it does work but I need the conditional formatting
Public Function Send2Excel(strTableName As String, Optional strSheetName As String)
' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to

    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim fld As Field
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    On Error GoTo err_handler
    Set rst = CurrentDb.OpenRecordset(strTableName)
    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
    Set xlWSh = xlWBk.Worksheets("Sheet1")
    If Len(strSheetName) > 0 Then
        xlWSh.Name = Left(strSheetName, 34)
    End If

    For Each fld In rst.Fields
        ApXL.ActiveCell = fld.Name
        ApXL.ActiveCell.Offset(0, 1).Select
    xlWSh.Range("A2").CopyFromRecordset rst
    ' This is included to show some of what you can do about formatting.  You can comment out or delete
    ' any of this that you don't want to use in your own export.
    With ApXL.Selection.Font
        .Name = "Arial Narrow"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    [b]    '.BackColor = vbBlue [/b][i]This didn't work[/i]
        End With
        With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    End With
    ApXL.Selection.Font.Bold = True
    With ApXL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ' selects all of the cells
    ' does the "autofit" for all columns
    ' selects the first cell to unselect all cells
    Set rst = Nothing
    Exit Function
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
End Function

Open in new window

not sure what how to tell this to make the background color different based on the status field. Also I don't see where I can put the resulting spreadsheet in the propery directory.

Author Comment

ID: 40035433
If I have to settle for send2excel without conditional formatting, how do I get it to save this spreadsheet? It just opens it now and leaves it open. Thanks.
Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

LVL 27

Accepted Solution

MacroShadow earned 250 total points
ID: 40043684
I'm not sure why you wrote a function when previously you had successfully used Docmd.TransferSpreadsheet.

Reading your initial question, it seems that you want to format an Excel spreadsheet from Access, adding conditional formatting too.

Basically, stick to Docmd.TransferSpreadsheet to export the query to an Excel file in the desired location.

Once exported you can automate the spreadsheet from Access this snippet will give you an idea as to how. If you supply a dummy file I will give you complete code.

    Dim oExcel As Object
    Dim oWorkbook As Object

    Set oExcel = CreateObject("Excel.Application")
    Set oWorkbook = oExcel.Workbooks.Open("C:\Test\Test.xlsx")

    ' Apply conditional formatting to range A2:H101 on the first worksheet
    ' if $F3 is equal or larger than $E3 apply green interior color to that row
    With oWorkbook.Sheets(1).Range("A2:H101")
        .FormatConditions.Add Type:=xlExpression, Formula1:="=IF($F3>=$E3,TRUE,FALSE)"
        With .FormatConditions(.FormatConditions.Count)
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = 5287936
            End With
        End With
    End With
    ' will set left jusify A2
    With oWorkbook.Sheets(1).Range("A2")
        .HorizontalAlignment = xlLeft
    End With

Open in new window

LVL 18

Expert Comment

by:Richard Daneke
ID: 40044087
Can you use a template in the output that is formatted or an AutoExec macro to format the file after output?

Author Comment

ID: 40044313
I use
e DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "qryofrecordsexcel", "C:Database Request Log.xls", True

Open in new window

I open the database at 6:00 AM so it is automated.
LVL 27

Expert Comment

ID: 40044721

I use

e DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "qryofrecordsexcel", "C:Database Request Log.xls", True
Select allOpen in new window

I open the database at 6:00 AM so it is automated.

I don't understand, how does that relate to any of the above suggestions?
LVL 31

Assisted Solution

Helen_Feddema earned 250 total points
ID: 40045275
Your question was about using VBA to create a formatted Excel workbook; TransferSpreadsheet does a basic data dump, with no formatting.  For best results, I recommend creating an Excel template with titles, column headings, etc. formatted as you wish, and then filling it with data from Access, using Automation code.  

Here is some sample code from my recent Working with Excel ebook's sample database (the 2003 version):

Public Sub CreateInspectionReport(lngVehicleID As Long)
'Created by Helen Feddema 11-Jun-2010
'Last modified by Helen Feddema 9-Oct-2011

On Error GoTo ErrorHandler

   Dim appExcel As New Excel.Application
   strRecordSource = "tblVehicles"
   strQuery = "qrySelectedVehicle"
   strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _
      & "[VehicleID] = " & lngVehicleID & ";"
   Debug.Print "SQL for " & strQuery & ": " & strSQL
   lngCount = CreateAndTestQuery(strQuery, strSQL)
   Debug.Print "No. of items found: " & lngCount
   If lngCount = 0 Then
      strPrompt = "No records found; canceling"
      strTitle = "Canceling"
      MsgBox strPrompt, vbOKOnly + vbCritical, strTitle
      GoTo ErrorHandlerExit
      Set rst = CurrentDb.OpenRecordset(strQuery)
   End If
   'Create new workbook from template
   strDocsPath = GetProperty("DocumentsPath", "")
   strTemplatesPath = GetProperty("TemplatesPath", "")
   strTemplate = strTemplatesPath & "\Northwind Inspection Report.xlt"
   Set wkb = appExcel.Workbooks.Add(template:=strTemplate)
   Set sht = wkb.Sheets(1)
   appExcel.Visible = True
   'Write data for selected vehicle to cells of worksheet
   sht.Range("A5").Value = rst![Appraiser]
   sht.Range("C5").Value = rst![ClaimNumber]
   sht.Range("E5").Value = Format(rst![ClaimDate], "mmm d, yyyy")
   sht.Range("A7").Value = rst![Inspector]
   sht.Range("B7").Value = rst![Location]
   sht.Range("D7").Value = rst![YearMakeModel]
   sht.Range("G7").Value = rst![AppraiserRate]
   sht.Range("H7").Value = rst![InspectorRate]
   sht.Range("A9").Value = Format(rst![InspectionDate], "dd-mmm-yyyy")
   sht.Range("B9").Value = Format(rst![CompDate], "dd-mmm-yyyy")
   sht.Range("C9").Value = rst![VIN]
   sht.Range("D9").Value = rst![Mileage]
   sht.Range("E9").Value = rst![Plate]
   sht.Range("F9").Value = rst![State]
   sht.Range("G9").Value = rst![LaborTax]
   sht.Range("H9").Value = rst![PartsTax]
   rst![ReportSent] = Date
   'Protect and save filled-in workbook
   sht.Protect DrawingObjects:=True, _
     Contents:=True, _
   sht.EnableSelection = xlUnlockedCells
   strSaveName = strDocsPath & "\Preliminary Vehicle Inspection Report for " _
      & rst![YearMakeModel] & ".xls"
   Debug.Print "Save name: " & strSaveName
   wkb.SaveAs FileName:=strSaveName
   strTitle = "Export successful"
   strPrompt = strSaveName & " created"
   MsgBox prompt:=strPrompt, _
      Buttons:=vbInformation + vbOKOnly, _
   Set appExcel = Nothing
   Exit Sub

   MsgBox "Error No: " & Err.Number _
      & " in CreateInspectionReport procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Sub

Open in new window


Author Closing Comment

ID: 40100725
This was a very difficult problem but the solution used details from the two answers. Thank you for the assistance.

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Is it possible to reset DSum? 12 40
Update As Well As Add 6 34
Merging-Splitting-Multiple-Rows 33 42
linked subforms are yielding error:  ... (800110108) 3 14
Outlook Free & Paid Tools
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

930 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now