Manufacturing Information Solutions Forum Index Manufacturing Information Solutions
Your Place for Support and Discussions
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Formatting Excel from Access

 
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> Microsoft Access
View previous topic :: View next topic  
Author Message
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Tue Sep 23, 2014 7:05 am    Post subject: Formatting Excel from Access Reply with quote

Code:

 Dim MyExcel As Object 'This is the excel object
   'Might need to set reference to Excel in Tools-->Reference

    Dim MyBook As Object
    Dim MySheet As Object

Sub Acad_Cons1()
    .
    .
    .
    Set MyExcel = CreateObject("Excel.Application")
    MyExcel.Visible = False
    Set MyBook = MyExcel.Workbooks.Add
    Set MySheet = MyBook.Worksheets.Add
    MySheet.Move After:=MyBook.Sheets(MyBook.Sheets.Count)
    .
    .
    .

    With MySheet.Rows("4:4")
        '.HorizontalAlignment = xlHAlignCenter          'Run-Time Error 1004
        '.Cells.HorizontalAlignment = xlHAlignCenter    'Run-Time Error 1004
        '.HorizontalAlignment = xlCenter                'Run-Time Error 1004
        .HorizontalAlignment = -4108                    'Works fine and centers cell contents correctly
        '.HorizontalAlignment = Constants.xlCenter      'Error, Data member not found
        '.Cells.HorizontalAlignment = xlCenter          'Run-Time Error 1004
        '.VerticalAlignment = xlCenter                  'Run-time Error 1004
        .VerticalAlignment = -4108                      'Works fine and centers cell contents correctly
        .WrapText = True                                'Works Fine
        .Font.Bold = True                               'Works Fine
        .Font.Name = "Arial"                            'Works Fine
        .Font.Size = 10                                 'Works Fine
        .Cells.RowHeight = 13                           'Works Fine
        '.Borders(xlEdgeBottom).LineStyle = xlContinuous    'Run-Time Error
        '.Borders(xlEdgeBottom).Weight = xlThick            'Run-time Error
       
    End With
    .
    .
    .

End Sub
Back to top
View user's profile Send private message Send e-mail
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Tue Sep 23, 2014 7:10 am    Post subject: Specify columns to be numeric showing 2 decimal places Reply with quote

Code:

Sub exL()
'specify columns H to be numeric showing 2 decimal places

Dim oExcel As Excel.Application
Set oExcel = CreateObject("Excel.Application")
With oExcel
.Workbooks.Add
.Sheets("Sheet1").Select
.Columns("E:G").NumberFormat = "0.00"
.Visible = True
End With
End Sub
Back to top
View user's profile Send private message Send e-mail
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Tue Sep 23, 2014 7:13 am    Post subject: Using a Macro to create the code for formatting Reply with quote

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.
Back to top
View user's profile Send private message Send e-mail
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Tue Sep 23, 2014 7:17 am    Post subject: Reply with quote

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.


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)
            .SetFirstPriority
            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
Back to top
View user's profile Send private message Send e-mail
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Tue Sep 23, 2014 7:35 am    Post subject: Reply with quote

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):

Code:

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
   Else
      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
   rst.Edit
   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
   rst.Update
   
   'Protect and save filled-in workbook
   sht.Protect DrawingObjects:=True, _
     Contents:=True, _
     Scenarios:=True
   sht.EnableSelection = xlUnlockedCells
   sht.Range("A13").Select
   
   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, _
      Title:=strTitle
   
ErrorHandlerExit:
   Set appExcel = Nothing
   Exit Sub

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

End Sub
Back to top
View user's profile Send private message Send e-mail
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Tue Sep 23, 2014 7:37 am    Post subject: Reply with quote

With a little VBA code, you can do quite a bit of formatting from within Access.

My code opens the sheet, bolds the columns in the first row, then autofilters the row and auto-fits the columns. When it's done, it saves and exits Excel (all behind the scenes). I just provide a message box when the export is complete.

In my case, I've got a transfer spreadsheet command followed by a call of my modify format function:

Code:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QueryName", "\\server\filename.xls", True
Call ModifyExportedExcelFileFormats("\\server\filename.xls", "QueryName")


and

Code:

Public Sub ModifyExportedExcelFileFormats(sFile As String, sSheet As String)
10    On Error GoTo Proc_Error

    Dim xlApp As Object
    Dim xlSheet As Object

20    Set xlApp = CreateObject("Excel.Application")
30    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)
   
40        With xlApp
50            .Application.Sheets(sSheet).Select
60            .Application.Rows("1:1").Select
70            .Application.Selection.Font.Bold = True
80            .Application.range("A1").Select
90            .Application.Selection.AutoFilter
100           .Application.Cells.Select
110           .Application.Selection.Columns.AutoFit
120            .Application.range("A1").Select
130            .Application.Activeworkbook.Save
140            .Application.Activeworkbook.Close
150            .Quit
160       End With




Exit_Proc:
170    Set xlApp = Nothing
180    Set xlSheet = Nothing
190       Exit Sub
Back to top
View user's profile Send private message Send e-mail
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Tue Sep 23, 2014 10:46 am    Post subject: Reply with quote

This code exports a query then opens the Excel file and does some formatting and shades every other line.


Code:

On Error GoTo Error_Handler
    Dim strWorksheetPath As String

    strWorksheetPath = "C:\Temp\"
    strWorksheetPath = strWorksheetPath & "ProjectReport " & Format(Date, "mmddyyyy") & ".xls"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryForExcel", strWorksheetPath, True
   
   
    Dim xlApp As Object
    Dim xlSheet As Object
    Dim sFile As String
    Dim sSheet As String

    sFile = strWorksheetPath
     sSheet = "qryForExcel"
    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)
     
   
        With xlApp
            .Application.Sheets(sSheet).Select
           .Application.Rows("1:1").Select
            .Application.Selection.Font.Bold = True
            .Application.Range("A1").Select
            .Application.Selection.AutoFilter
           .Application.Cells.Select
           .Application.Selection.Columns.AutoFit
            .Application.Range("A1").Select
            .Application.Columns("J:K").Select
            .Application.Selection.ClearContents
            .Application.Range("A1").Select
           
            .Application.Range("A2").EntireRow.Select    'Start of the shading of every other row
            Do While .Application.ActiveCell.Value <> ""
              .Application.Selection.Interior.ColorIndex = 15
              .Application.ActiveCell.Offset(2, 0).EntireRow.Select
            Loop
                     
            .Application.Range("A1").Select  'Go back to the first cell
            .Application.Activeworkbook.Save
            .Application.Activeworkbook.Close
            .Quit
       End With

Exit_Proc:
   Set xlApp = Nothing
  Set xlSheet = Nothing


MsgBox "Data has been saved to: " & strWorksheetPath


Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: btnExportReport_Click" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit


Last edited by mistux on Tue Sep 23, 2014 2:59 pm; edited 1 time in total
Back to top
View user's profile Send private message Send e-mail
mistux
Site Admin


Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA

PostPosted: Tue Sep 23, 2014 11:28 am    Post subject: Shade every other row Reply with quote

Shade every other row


Code:

With Range("A1").CurrentRegion
    .FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=1"
    .FormatConditions(1).Interior.ColorIndex = 3
End With
Back to top
View user's profile Send private message Send e-mail
Display posts from previous:   
Post new topic   Reply to topic    Manufacturing Information Solutions Forum Index -> Microsoft Access All times are GMT - 5 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group