Hi again guys and girls,
I am having my first real crack of VBA within Access to export and format Excel. My current code is as follows:
What I would like to do is add a bit at the bottom to change cell background colours depending on cell contents. I want a cell containing 'At Risk' to have bold text and a red background, 'Caution' to have an orange background with italic text and 'On Track' to have a green background.
I also have some (what I think are) easier questions. Two bits of my code aren't working as expected:
I expected this to close any open instances of Excel but it doesn't. Why is this?
This bit:
I expect to close and save what I just created but it doesn't. What have I done wrong? What would be even better than this is if I could change the papersize to Tabloid, landscape and shrint to fit columns on one page then save as a .pdf. That would be the ultimate goal here but to save would be ideal.
One last thing -
I wanted to centre on row 2 but it didn't work. Now commented out. What is the right way to centre text?
So far I have tried the following alternitives:
I'm not sure where to put the colour filtering code. If I put it before the End With I get a compile error: End With without With and if I put it after the End With I get a compile error: Invalid or unqualified reference on the .autofiltermode.
I have tried alternatives for xlcenter as well:
this throws a runtime error '1004' Unable to set the HorozontalAlignment property of the Range class
I'm using Office 2013
Thanks for the help on a weekend.
I am having my first real crack of VBA within Access to export and format Excel. My current code is as follows:
Code:
Sub ExportToExcel()
On Error GoTo errorhandler
Dim xlApp As Object
Dim xlSheet As Object
Dim oBook As Object
Dim stamp As String
stamp = Month(Date) & Day(Date) & Year(Date)
'check & close any instance of Excel running
Set xlApp = CreateObject("Excel.Application")
If Not (xlApp Is Nothing) Then
xlApp.Application.DisplayAlerts = False
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing
End If
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Dim outputFileName As String
outputFileName = CurrentProject.Path & "\Export_" & Format(Date, "yyyyMMdd") & ".xls"
DoCmd.OutputTo acOutputReport, ActiveReport, acFormatXLS, outputFileName, True
xlApp.Workbooks.Open outputFileName, True, False
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set XlBook = GetObject(outputFileName)
XlBook.Windows(1).Visible = True
'xl.ActiveWindow.Zoom = 75
'Define the sheet in the Workbook as XlSheet
Set xlsheet1 = XlBook.Worksheets(1)
Set oBook = xlApp.Workbooks.Open(outputFileName)
'Then have some fun!
With xlsheet1
' .range("A1") = "some data here"
' .columns("A:A").HorizontalAlignment = xlRight
' .rows("1:1").Font.Bold = True
' Dim lRow As Long
'lRow = Cells(Rows.Count, 1).End(xlUp).Row
.Columns("A:A").EntireColumn.AutoFit
.Columns("b:b").EntireColumn.AutoFit
.Columns("c:c").EntireColumn.AutoFit
.Columns("d:d").EntireColumn.ColumnWidth = 5
.Columns("f:f").EntireColumn.AutoFit
.Columns("g:g").EntireColumn.AutoFit
.Columns("h:h").EntireColumn.AutoFit
.Columns("i:i").EntireColumn.AutoFit
.Columns("j:j").EntireColumn.AutoFit
.Columns("k:k").EntireColumn.AutoFit
.Columns("l:l").EntireColumn.AutoFit
.Columns("m:m").EntireColumn.AutoFit
.Columns("n:n").EntireColumn.AutoFit
.Columns("o:o").EntireColumn.AutoFit
.Columns("p:p").EntireColumn.AutoFit
.Columns("q:q").EntireColumn.AutoFit
.Columns("r:r").EntireColumn.AutoFit
.Range("R2").clearcontents
.Range("B1").clearcontents
.Columns("E:E").WrapText = True
End With
'Filter only rows where cell value = 1 to speed up color formatting by only
'editing the filtered rows rather than all the rows in the range
'20160218
.autofiltermode = False
.Range(.Cells(1, 1), .Cells(lastrow, 1)).AutoFilter Field:=1, Criteria1:="1"
For Each cell In .Range(.Cells(2, 1), .Cells(lastrow, 1)).SpecialCells(xlCellTypeVisible)
'For Each cell In .Range(.Cells(2, 1), .Cells(lastrow, 1))
Select Case cell.Value
Case Is = 1: indexcolor = 3 'vbred
Case Is = 0: indexcolor = 1 'vbblack
Case Else: indexcolor = xlNone
End Select
.rows(2).HorizontalAlignment = xlCenter
.Range("A2:A65000").rows.AutoFit
' ActiveWorkbook.Close SaveChanges:=True
oBook.Close True 'True = save changes
Exit_Proc:
Set xlApp = Nothing
Set xlSheet = Nothing
Exit Sub
errorhandler:
MsgBox ("There is an error in the report." & vbNewLine & "Check Date Milestone Met column." & vbNewLine & "Ensure one of steps, 1, 4, 11, 12, 13 15, 21, 22, 24, 28, 35,36 or 38 are selected." & vbNewLine & "Ensure MS Excel is not already open when trying to export" & vbNewLine & "If error still persists after these checks contact administrator")
End Sub
What I would like to do is add a bit at the bottom to change cell background colours depending on cell contents. I want a cell containing 'At Risk' to have bold text and a red background, 'Caution' to have an orange background with italic text and 'On Track' to have a green background.
I also have some (what I think are) easier questions. Two bits of my code aren't working as expected:
Code:
'check & close any instance of Excel running
Set xlApp = CreateObject("Excel.Application")
If Not (xlApp Is Nothing) Then
xlApp.Application.DisplayAlerts = False
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing
End If
I expected this to close any open instances of Excel but it doesn't. Why is this?
This bit:
Code:
Set oBook = xlApp.Workbooks.Open(outputFileName)
...
oBook.Close True 'True = save changes
I expect to close and save what I just created but it doesn't. What have I done wrong? What would be even better than this is if I could change the papersize to Tabloid, landscape and shrint to fit columns on one page then save as a .pdf. That would be the ultimate goal here but to save would be ideal.
One last thing -
Code:
' .cells("2:2").select.HorizontalAlignment = xlCenter
I wanted to centre on row 2 but it didn't work. Now commented out. What is the right way to centre text?
So far I have tried the following alternitives:
Code:
'Filter only rows where cell value = 1 to speed up color formatting by only
'editing the filtered rows rather than all the rows in the range
'20160218
.autofiltermode = False
.Range(.Cells(1, 1), .Cells(lastrow, 1)).AutoFilter Field:=1, Criteria1:="1"
For Each cell In .Range(.Cells(2, 1), .Cells(lastrow, 1)).SpecialCells(xlCellTypeVisible)
'For Each cell In .Range(.Cells(2, 1), .Cells(lastrow, 1))
Select Case cell.Value
Case Is = 1: indexcolor = 3 'vbred
Case Is = 0: indexcolor = 1 'vbblack
Case Else: indexcolor = xlNone
End Select
Code:
'Conditional Formatting
For Each cell In .Range(.Cells(3, 3), .Cells(lastrow, 3))
Select Case cell.Value
Case Is = 5: indexcolor = 6 'stRGB = "rgb(255,255,0)" Couldn't figure out how to put the rgb in variable
Case Is = 10: indexcolor = 45 'stRGB = "rgb(255,192,0)" so used the closest ColorIndex based on the above
Case Is = 15: indexcolor = 43 'stRGB = "rgb(146,208,80)" mentioned website
Case Is = 20: indexcolor = 38 'stRGB = "rgb(255,204,255)"
Case Is = "ALL": indexcolor = 28 'stRGB = "rgb(0,255,255)"
End Select
.Range(.Cells(cell.row, 1), .Cells(cell.row, lastCol + 1)).Interior.ColorIndex = indexcolor
Next cell
I'm not sure where to put the colour filtering code. If I put it before the End With I get a compile error: End With without With and if I put it after the End With I get a compile error: Invalid or unqualified reference on the .autofiltermode.
I have tried alternatives for xlcenter as well:
Code:
.rows(2).HorizontalAlignment = xlCenter
this throws a runtime error '1004' Unable to set the HorozontalAlignment property of the Range class
I'm using Office 2013
Thanks for the help on a weekend.