Results 1 to 3 of 3

Export to Excel, Change Cell Colour

  1. #1
    nick1408 is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    Jul 2016
    Posts
    1

    Export to Excel, Change Cell Colour

    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:

    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.

  2. #2
    alansidman's Avatar
    alansidman is offline Life @ 7100'
    Windows 10 Access 2013
    Join Date
    Apr 2010
    Location
    Steamboat Springs
    Posts
    2,436

  3. #3
    Micron is offline Virtually Inert Person
    Windows 7 32bit Access 2007
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    6,428
    - "doesn't work" is no help. Post err msgs and where.
    - Use code tags for code/sql. Implement changes in copies of your database.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 1
    Last Post: 03-11-2016, 01:27 PM
  2. export to excel starting from Cell A2
    By ice051505 in forum Programming
    Replies: 7
    Last Post: 04-25-2013, 03:15 PM
  3. Replies: 4
    Last Post: 09-19-2012, 11:49 AM
  4. Changing the colour of a cell?
    By WayneSteenkamp in forum Access
    Replies: 3
    Last Post: 03-08-2012, 10:12 AM
  5. Export a value to specific Excel cell
    By gg80 in forum Import/Export Data
    Replies: 5
    Last Post: 07-23-2010, 01:58 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Tech Forums: Microsoft Office Forums