 |
Manufacturing Information Solutions
Your Place for Support and Discussions
|
| View previous topic :: View next topic |
| Author |
Message |
mistux
Site Admin
Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA
|
 Posted: Tue Sep 23, 2014 7:05 am Post subject: Formatting Excel from Access |
 |
|
| 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 |
|
 |
mistux
Site Admin
Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA
|
| Posted: Tue Sep 23, 2014 7:10 am Post subject: Specify columns to be numeric showing 2 decimal places |
|
|
| 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 |
|
|
mistux
Site Admin
Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA
|
| Posted: Tue Sep 23, 2014 7:13 am Post subject: Using a Macro to create the code for formatting |
|
|
| 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 |
|
|
mistux
Site Admin
Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA
|
| Posted: Tue Sep 23, 2014 7:17 am Post subject: |
|
|
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 |
|
|
mistux
Site Admin
Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA
|
| Posted: Tue Sep 23, 2014 7:35 am Post subject: |
|
|
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 |
|
|
mistux
Site Admin
Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA
|
| Posted: Tue Sep 23, 2014 7:37 am Post subject: |
|
|
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 |
|
|
mistux
Site Admin
Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA
|
| Posted: Tue Sep 23, 2014 10:46 am Post subject: |
|
|
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 |
|
|
mistux
Site Admin
Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA
|
| Posted: Tue Sep 23, 2014 11:28 am Post subject: Shade every other row |
|
|
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 |
|
|
|
|
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
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
