Link to home
Start Free TrialLog in
Avatar of gdunn59
gdunn59

asked on

VBA Code in Access Giving Errors on the Formatting

I have a MS Access Database that dumps data from a query into an Excel Spreadsheet, and then formats the spreadsheet.  The problem I'm having is that I upgraded from Windows XP and Office 2007 to Windows 7 and Office 2010.  Since this upgrade, my VBA code is not working 100%.  I'm getting some errors on the VBA code that formats the spreadsheet once the data is dumped from Access to Excel.

All of the formatting code where I'm getting errors, I have commented out.  Below are two lines of code where I'm getting errors.  The remainder of the formatting code that I've commented out also, is getting the same errors as below (depending on which line of code it is that is similar to the 2 different lines of code mentioned below and the errors I get).

On line 38-42 of the code, I'm getting the following error:
   "Subscript out of range"

On Line 53-60 of the code, I'm getting the following error:
   "Application-Defined Error or Object-Defined Error"

Lines 45-50 of the code works fine.

I have included the portion of the code that is giving me errors, below:

Set xlObj = CreateObject("excel.application")

If IsNull(Me.cboReportCateg) Or IsNull(Me.cboCategSelect) Then
    MsgBox "Please make selections from the drop-downs for a Auditor, Department, Employee or Manager", vbOKOnly
    Me.cboReportCateg.SetFocus
    Me.cboReportCateg.Dropdown
End If

' check to see if Table "tblErrorDetails (for Report)" contains data
If DCount("*", "tblErrorDetails (for Report)") > 0 Then
    xlObj.Workbooks.Add templateFile
'    xlObj.Workbooks.Add TemplatefileC
        With xlObj
            .Worksheets(1).Select
            .Range("A5").Select
            Set qdf = CurrentDb.QueryDefs("qryErrorDetails_Summary")
            Set rs = qdf.OpenRecordset
            .Selection.CopyFromRecordset rs
            rs.Close
                
            .Worksheets(2).Select
            .Range("A5").Select
            Set qdf2 = CurrentDb.QueryDefs("qryErrorDetails")
                        
            Set rs2 = qdf2.OpenRecordset
            .Selection.CopyFromRecordset rs2
            rs2.Close
        End With
        
        
            Dim lRow As Long
            'Process if Begin or End Dates are not null
            If Me.txtBeginDT <> "" Or Me.txtEndDT <> "" Then
            'Go back to top of Spreadsheet and Save to Report Name
                With xlObj.Worksheets(1)
                    .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
'                    With xlObj.Range("A1:A2").Font
'                        .Bold = True
'                        .Themecolor = xlThemeColorAccent1
'                        .TintAndShade = -0.249977111117893
'                    End With
                    
                                        
                        xlObj.Cells.Select
                        .Cells.WrapText = False
                        .Cells.EntireColumn.AutoFit
                        .Cells.Rows.AutoFit
                        
                        xlObj.Range("A5").Select
        

'                    lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
'                    .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
'                    .Range("B" & lRow + 1).Font.Bold = True
'                    .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
'                    .Range("A" & lRow + 1).Font.Bold = True
'                    .Range("A" & lRow + 1).HorizontalAlignment = xlRight
'                    .Range("A" & lRow + 1).VerticalAlignment = xlBottom
'                    .Range("A" & lRow + 1).Font.Color = -16776961
                    
                End With
                
'                With xlObj.Worksheets(1).Range("B" & lRow).Borders(xlEdgeBottom)
'                    .LineStyle = xlContinuous
'                    .ColorIndex = 0
'                    .TintAndShade = 0
'                    .Weight = xlThin
'                End With
'
                With xlObj.Worksheets(1)
                    lRow = .Cells(.Rows.Count, "C").End(xlUp).Row
                    .Range("C" & lRow + 1).Formula = "=Sum(C5:C" & lRow & ")"
                    .Range("C" & lRow + 1).Font.Bold = True
                End With
'
'                With xlObj.Worksheets(1).Range("C" & lRow).Borders(xlEdgeBottom)
'                    .LineStyle = xlContinuous
'                    .ColorIndex = 0
'                    .TintAndShade = 0
'                    .Weight = xlThin
'                End With
'
'                With xlObj.Worksheets(1)
'                    lRow = .Cells(.Rows.Count, "D").End(xlUp).Row
'                    .Range("D" & lRow + 1).Formula = "=Sum(D5:D" & lRow & ")"
'                    .Range("D" & lRow + 1).Font.Bold = True
'                End With
'
'                With xlObj.Worksheets(1).Range("D" & lRow).Borders(xlEdgeBottom)
'                    .LineStyle = xlContinuous
'                    .ColorIndex = 0
'                    .TintAndShade = 0
'                    .Weight = xlThin
'                End With
    
                With xlObj.Worksheets(2)
                    .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
                    
                    .Range("A2").Select
                    .Range("A2").Font.Bold = True

                    .Range("A1:A2").Font.Bold = True
                    .Range("A1:A2").ForeColor.Fill.ObjectThemecolor = xlThemeColorAccent1
                    .Range("A1:A2").Font.ForeColor.Fill.ObjectTintAndShade = -0.249977111117893
                    
                    
'                      .ForeColor.ObjectThemecolor = wdThemeColorAccent1

                        
                    xlObj.Cells.Select
                    .Cells.WrapText = False
                    .Cells.EntireColumn.AutoFit
                    .Cells.Rows.AutoFit
                        
                    .Range("A5").Select
                End With
            
                xlObj.ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
'                xlObj.ActiveWorkbook.SaveAs strOutputToPathCDrive, CreateBackup:=False
                                
                DoCmd.Hourglass False
                DoCmd.Echo False
                xlObj.Visible = True
                xlObj.Worksheets(1).Select
                xlObj.Range("A5").Select
                DoCmd.Echo True
        
            Else
                With xlObj.Worksheets(1)
                    .Range("A1").Value = "For Dates:  " & DMin("[Review Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Review Date]", "tblErrorDetails (for Report)")
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
'                    With .Range("A1:A2").Font
'                        .Bold = True
'                        .Themecolor = xlThemeColorAccent1
'                        .TintAndShade = -0.249977111117893
'                    End With
                    
'                    lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
'                    .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
'                    .Range("B" & lRow + 1).Font.Bold = True
'                    .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
'                    .Range("A" & lRow + 1).Font.Bold = True
'                    .Range("A" & lRow + 1).HorizontalAlignment = xlRight
'                    .Range("A" & lRow + 1).VerticalAlignment = xlBottom
'                    .Range("A" & lRow + 1).Font.Color = -16776961
                End With
'
'                With xlObj.Worksheets(1).Range("B" & lRow).Borders(xlEdgeBottom)
'                    .LineStyle = xlContinuous
'                    .ColorIndex = 0
'                    .TintAndShade = 0
'                    .Weight = xlThin
'                End With
'
'                With xlObj.Worksheets(1)
'                    lRow = .Cells(.Rows.Count, "C").End(xlUp).Row
'                    .Range("C" & lRow + 1).Formula = "=Sum(C5:C" & lRow & ")"
'                    .Range("C" & lRow + 1).Font.Bold = True
'                End With
'
'                With xlObj.Worksheets(1).Range("C" & lRow).Borders(xlEdgeBottom)
'                    .LineStyle = xlContinuous
'                    .ColorIndex = 0
'                    .TintAndShade = 0
'                    .Weight = xlThin
'                End With
'
'                With xlObj.Worksheets(1)
'                    lRow = .Cells(.Rows.Count, "D").End(xlUp).Row
'                    .Range("D" & lRow + 1).Formula = "=Sum(D5:D" & lRow & ")"
'                    .Range("D" & lRow + 1).Font.Bold = True
'                End With
'
'                With xlObj.Worksheets(1).Range("D" & lRow).Borders(xlEdgeBottom)
'                    .LineStyle = xlContinuous
'                    .ColorIndex = 0
'                    .TintAndShade = 0
'                    .Weight = xlThin
'                End With
    
                With xlObj.Worksheets(2)
                    .Range("A1").Value = "For Dates:  " & DMin("[Review Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Review Date]", "tblErrorDetails (for Report)")
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
'                    With .Range("A1:A2").Font
'                        .Bold = True
'                        .Themecolor = xlThemeColorAccent1
'                        .TintAndShade = -0.249977111117893
'                    End With
                    xlObj.Cells.Select
                    .Cells.WrapText = False
                    .Cells.EntireColumn.AutoFit
                    .Cells.Rows.AutoFit
                    
                    .Range("A5").Select

                End With
                                
                xlObj.ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
'                xlObj.ActiveWorkbook.SaveAs strOutputToPathCDrive, CreateBackup:=False

                DoCmd.Hourglass False
                DoCmd.Echo False
                xlObj.Visible = True
                xlObj.Worksheets(1).Select
                xlObj.Range("A5").Select
                DoCmd.Echo True
            End If
    
Else
    'if table "tblErrorDetails (for Report)" contains no data
    MsgBox "There are no results for the selected criteria. Please revise your criteria, and try again.", vbOKOnly
    Me.cboCategSelect.SetFocus
End If

Open in new window

Avatar of Dale Fye
Dale Fye
Flag of United States of America image
xlObj refers to Excel, not a specific workbook or worksheet.

I usually define workbooks and worksheets too, so that if the particular instance of Excel has multiple workbooks open it knows what workbook and what worksheet to be working with.

Dim wbk as Excel.Workbook
Dim sht as Excel worksheet

Then, near line 12/ I would define those:

Set wbk = xlObj.workbooks(1)
set sht = wbk.worksheets(1)

Then, instead of using:

With xlObj

I would generally use:

With sht

Lines 35-42 might look like:

    With sht
        .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
        .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
        With .Range("A1:A2").Font
             .Bold = True
             .Themecolor = xlThemeColorAccent1
             .TintAndShade = -0.249977111117893
        End With

Open in new window

Avatar of gdunn59
gdunn59

ASKER

fyed:

Isn't this the same (this is what I have):

                With xlObj.Worksheets(1)

xlObj is defined as the workbook, and Worksheets(1) is for sheet 1.

Thanks,
gdunn59
Avatar of gdunn59
gdunn59

ASKER

I tried, but still getting the same errors.  It has something to do with the upgrade to Access 2010, because it all worked fine before that.

thanks,

gdunn59
Avatar of Dale Fye
Dale Fye
Flag of United States of America image
In 38-42 you used:

 With xlObj.Range("A1:A2").Font
         .Bold = True
         .Themecolor = xlThemeColorAccent1
         .TintAndShade = -0.249977111117893
End With

You might be able to do that as:

 With xlObj.Worksheets(1).Range("A1:A2").Font
         .Bold = True
         .Themecolor = xlThemeColorAccent1
         .TintAndShade = -0.249977111117893
End With

but it is not going to work with xlObj.Range("A1:A2") because it doesn't know what worksheet or workbook that range applies to.
Avatar of gdunn59
gdunn59

ASKER

fyed:

I tried your last posting, and I'm still getting the following error:

  "Subscript out of range"

on this line of code:

  .Themecolor = xlThemeColorAccent1


Thanks,
gdunn59
Avatar of gdunn59
gdunn59

ASKER

fyed:

I figured out the issue.  As I mentioned in my original posting all of this worked prior to upgrading to Windows 7 and Office 2010.

I have determined that the reason it is not working is because some of the constants in VBA that had a "name" (i.e. xlThemeColor1) are now recognized by a "number" (i.e. 2) instead, in MS Office 2010.

I'm still trying to figure out the rest of the formatting issues I'm having.

Thanks,
gdunn59
Avatar of gdunn59
gdunn59

ASKER

I'm still getting the following error:

   "Application-Defined Error or Object-Defined Error"

On this line of code:

                    lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                    .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
                    .Range("B" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
                    .Range("A" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).HorizontalAlignment = xlRight
                    .Range("A" & lRow + 1).VerticalAlignment = xlBottom
                    .Range("A" & lRow + 1).Font.Color = -16776961

Open in new window

Avatar of andrewssd3
andrewssd3
Flag of United Kingdom of Great Britain and Northern Ireland image
Do you have a reference to Excel in the Tools...References dialog? You must have for the code to have worked before, but it seems like the places you are getting failures is where it is referring to the Excel constants that are defined by that reference.  If you have kept the older version of Excel on your machine, it's possible you are getting some conflict now you have upgraded.  I can't test this, but because you instantiate Excel using CreateObject, but also have a reference to it (which can be version dependent), you may be getting a conflict.

CreateObject("Excel.Application") will create an Excel object of the default version.  Try either using 
Set xlObj = New Excel.Application

Open in new window

, or check that the reference is to the correct Excel version.
Avatar of Robberbaron (robr)
Robberbaron (robr)
Flag of Australia image
to sum up, you are running this as a Access2010 VBA macro.

xlObj refers to the Excel application itself.

from there you need to refer to a Workbook, and then to the Worksheets.  it may be that by missing the workbook it automatically uses the ActiveWorkbook but that is prone to errors...  

i recommend changing to
      
Set wbA = xlObj.Workbooks.Add(templateFile)

Open in new window

 
this assigns the newly added workbook to wbA variable, rather than just Activeworkbook

the replace all further references to xlObj with wbA, as it is wbA that has worksheets , not xlObj.  

i have reformatted your snippet so that it at least passes compile check in Excel2007 vba.
 
     Set wbA = xlObj.Workbooks.Add(templateFile)

        With wbA 'xlObj
            .Worksheets(1).Select
            .ActiveSheet.Range("A5").Select
            Set qdf = CurrentDb.QueryDefs("qryErrorDetails_Summary")
            Set rs = qdf.OpenRecordset
            .ActiveSheet.Selection.CopyFromRecordset rs
            rs.Close
                
            .Worksheets(2).Select
            .ActiveSheet.Range("A5").Select
            Set qdf2 = CurrentDb.QueryDefs("qryErrorDetails")
                        
            Set rs2 = qdf2.OpenRecordset
            .ActiveSheet.Selection.CopyFromRecordset rs2
            rs2.Close
        End With
        
        
            Dim lRow As Long
            'Process if Begin or End Dates are not null
            If mex.txtBeginDT <> "" Or mex.txtEndDT <> "" Then
            'Go back to top of Spreadsheet and Save to Report Name
                With wbA.Worksheets(1)
                    .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
                    With .Range("A1:A2").Font
                        .Bold = True
                        .ThemeColor = xlThemeColorAccent1
                        .TintAndShade = -0.249977111117893
                    End With
                                                       
                        .Cells.Select
                        .Cells.WrapText = False
                        .Cells.EntireColumn.AutoFit
                        .Cells.Rows.AutoFit
                        
                        xlObj.Range("A5").Select
        

                    lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                    .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
                    .Range("B" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
                    .Range("A" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).HorizontalAlignment = xlRight
                    .Range("A" & lRow + 1).VerticalAlignment = xlBottom
                    .Range("A" & lRow + 1).Font.Color = -16776961
                    
                End With
                
                With wbA.Worksheets(1).Range("B" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With

                With wbA.Worksheets(1)
                    lRow = .Cells(.Rows.Count, "C").End(xlUp).Row
                    .Range("C" & lRow + 1).Formula = "=Sum(C5:C" & lRow & ")"
                    .Range("C" & lRow + 1).Font.Bold = True
                End With

                With wbA.Worksheets(1).Range("C" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With wbA.Worksheets(1)
                    lRow = .Cells(.Rows.Count, "D").End(xlUp).Row
                    .Range("D" & lRow + 1).Formula = "=Sum(D5:D" & lRow & ")"
                    .Range("D" & lRow + 1).Font.Bold = True
                End With
'
                With wbA.Worksheets(1).Range("D" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
    
                With wbA.Worksheets(2)
                    .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
                    .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
                    
                    .Range("A2").Select
                    .Range("A2").Font.Bold = True

                    .Range("A1:A2").Font.Bold = True
                    .Range("A1:A2").ForeColor.Fill.ObjectThemeColor = xlThemeColorAccent1
                    .Range("A1:A2").Font.ForeColor.Fill.ObjectTintAndShade = -0.249977111117893
                    
                    
'                      .ForeColor.ObjectThemecolor = wdThemeColorAccent1

                        
                    xlObj.Cells.Select
                    .Cells.WrapText = False
                    .Cells.EntireColumn.AutoFit
                    .Cells.Rows.AutoFit
                        
                    .Range("A5").Select
                End With
            
                wbA.SaveAs strOutputToPath, CreateBackup:=False
'                xlObj.ActiveWorkbook.SaveAs strOutputToPathCDrive, CreateBackup:=False
                                
                DoCmd.Hourglass False
                DoCmd.Echo False
                xlObj.Visible = True
                wbA.Worksheets(1).Select
                wbA.ActiveSheet.Range("A5").Select
                DoCmd.Echo True
        
            Else
                With wbA.Worksheets(1)
                    .Range("A1").Value = "For Dates:  " '& DMin("[Review Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Review Date]", "tblErrorDetails (for Report)")
                    .Range("A2").Value = "Filtered By:" '& " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
                    With .Range("A1:A2").Font
                        .Bold = True
                        .ThemeColor = xlThemeColorAccent1
                        .TintAndShade = -0.249977111117893
                    End With
                    
                    lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                    .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
                    .Range("B" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
                    .Range("A" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).HorizontalAlignment = xlRight
                    .Range("A" & lRow + 1).VerticalAlignment = xlBottom
                    .Range("A" & lRow + 1).Font.Color = -16776961
                End With
'
                With wbA.Worksheets(1).Range("B" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
'
                With wbA.Worksheets(1)
                    lRow = .Cells(.Rows.Count, "C").End(xlUp).Row
                    .Range("C" & lRow + 1).Formula = "=Sum(C5:C" & lRow & ")"
                    .Range("C" & lRow + 1).Font.Bold = True
                End With
'
                With wbA.Worksheets(1).Range("C" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
'
                With wbA.Worksheets(1)
                    lRow = .Cells(.Rows.Count, "D").End(xlUp).Row
                    .Range("D" & lRow + 1).Formula = "=Sum(D5:D" & lRow & ")"
                    .Range("D" & lRow + 1).Font.Bold = True
                End With
'
                With wbA.Worksheets(1).Range("D" & lRow).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
    
                With wbA.Worksheets(2)
                    .Range("A1").Value = "For Dates:  " ' & DMin("[Review Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Review Date]", "tblErrorDetails (for Report)")
                    .Range("A2").Value = "Filtered By:" '& " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
'                    With .Range("A1:A2").Font
'                        .Bold = True
'                        .Themecolor = xlThemeColorAccent1
'                        .TintAndShade = -0.249977111117893
'                    End With
                    .Cells.Select
                    .Cells.WrapText = False
                    .Cells.EntireColumn.AutoFit
                    .Cells.Rows.AutoFit
                    
                    .Range("A5").Select

                End With
                                
                xlObj.ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
'                xlObj.ActiveWorkbook.SaveAs strOutputToPathCDrive, CreateBackup:=False

                DoCmd.Hourglass False
                DoCmd.Echo False
                xlObj.Visible = True
                xlObj.Worksheets(1).Select
                xlObj.Range("A5").Select
                DoCmd.Echo True
            End If

Open in new window

Avatar of gdunn59
gdunn59

ASKER

Rob:

I used the code you posted above, and I'm still getting the following error:

    "Object doesn't support this property or method"

The error is happening on the Line 8 of your code posted above
    .ActiveSheet.Selection.CopyFromRecordset rs

Thanks,

gdunn59
Avatar of andrewssd3
andrewssd3
Flag of United Kingdom of Great Britain and Northern Ireland image
Your error is because ActiveSheet refers to a worksheet, which does not have a Selection property/method - that really does need to read xlObj.Selection

This not for points - it's Rob's solution, just trying to help.

Stuart
SOLUTION
Avatar of Robberbaron (robr)
Robberbaron (robr)
Flag of Australia image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of gdunn59
gdunn59

ASKER

Rob,

I changed the section of code listed in your last posting, and this worked, but now since I've gotten past that point, I'm getting the following error (THIS ALL WORKED FINE UNTIL I UPGRADED TO WINDOWS 7 AND OFFICE 2010, FROM WINDOWS XP AND OFFICE 2007):

     "Application-Defined Error or Object-Defined Error"

This error is happening on the following section of code:

                    lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                    .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
                    .Range("B" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
                    .Range("A" & lRow + 1).Font.Bold = True
                    .Range("A" & lRow + 1).HorizontalAlignment = xlRight
                    .Range("A" & lRow + 1).VerticalAlignment = xlBottom
                    .Range("A" & lRow + 1).Font.Color = -16776961

Open in new window


I was also getting an error on this line of code until I changed it to the number "2".  When I use the number "2", it is coming out the color "Black" instead of the "Blue" that I had before.  This worked fine in the 2007 Version of Access:

             Error on this line:
                           .ThemeColor = xlThemeColorAccent1

             I changed to:
                           .ThemeColor = 2


Thanks,
gdunn59
ASKER CERTIFIED SOLUTION
Avatar of Robberbaron (robr)
Robberbaron (robr)
Flag of Australia image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of gdunn59
gdunn59

ASKER

Rob,

In regards to the reference to Excel, I'm not selecting this in the references because not all users of this database are using the same version of Excel.  So I'm using Late Binding in the code instead.  So I need to know what the constant is for the Theme Color.  How do I get the constant in the Object Viewer?

Also, I see you responded to my issue with the Theme Color, but prior to that I had posted an error that I was getting with some of the other code (ID: 39883089).

Could you please assist with that, then I will deal with the Theme Color issue?

Thanks,

gdunn59
SOLUTION
Avatar of Robberbaron (robr)
Robberbaron (robr)
Flag of Australia image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of gdunn59
gdunn59

ASKER

Rob,

I ended up adding the following for the Constants:

Option Explicit
'Option Compare Database
Const xlRight = -4152
Const xlBottom = -4107
Const xlUp = -4162
Const xlEdgeBottom = 9
Const xlContinuous = 1
Const xlThin = 2
Const xlThemeColorAccent1 = 5
Const xlCancel = 1

Open in new window



Also used your solution (ID: 39881952):
Set wba = xlObj.Workbooks.Add(templatefile)
With wba 'xlObj
    Set rngA = .Worksheets(1).Range("A5")
    Set qdf = CurrentDb.QueryDefs("qryErrorDetails_Summary")
    Set rs = qdf.OpenRecordset
    rngA.CopyFromRecordset rs
    rs.Close
        
    Set rngB = .Worksheets(2).Range("A5")
    Set qdf2 = CurrentDb.QueryDefs("qryErrorDetails")
    Set rs2 = qdf2.OpenRecordset
    rngB.CopyFromRecordset rs2
    rs2.Close
End With
                
Dim lRow As Long
'Process if Begin or End Dates are not null
If Me.txtBeginDT <> "" Or Me.txtEndDT <> "" Then
'Go back to top of Spreadsheet and Save to Report Name
    With wba.Worksheets(1)
        .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
        .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
        With .Range("A1:A2").font
            .Bold = True
            .Themecolor = xlThemeColorAccent1
            .TintAndShade = -0.249977111117893
        End With
                                           
        .Cells.select
        .Cells.WrapText = False
        .Cells.EntireColumn.AutoFit
        .Cells.Rows.AutoFit
        
        .Columns("D:D").select
        .Columns.NumberFormat = "General"
        
        xlObj.Range("A5").select
            
        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
        .Range("B" & lRow + 1).font.Bold = True
        .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
        .Range("A" & lRow + 1).font.Bold = True
        .Range("A" & lRow + 1).HorizontalAlignment = xlRight
        .Range("A" & lRow + 1).VerticalAlignment = xlBottom
        .Range("A" & lRow + 1).font.Color = -16776961
        
    End With
    
    With wba.Worksheets(1).Range("B" & lRow).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

    With wba.Worksheets(1)
        lRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        .Range("C" & lRow + 1).Formula = "=Sum(C5:C" & lRow & ")"
        .Range("C" & lRow + 1).font.Bold = True
    End With

    With wba.Worksheets(1).Range("C" & lRow).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With wba.Worksheets(1)
        lRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        .Range("D" & lRow + 1).Formula = "=Sum(D5:D" & lRow & ")"
        .Range("D" & lRow + 1).font.Bold = True
    End With
    
    With wba.Worksheets(1).Range("D" & lRow).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

    With wba.Worksheets(2)
        .Range("A1").Value = "For Dates:" & " " & txtBeginDT & " thru " & txtEndDT
        .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"
        .Range("A2").font.Bold = True
        .Range("A1:A2").font.Bold = True
        .Range("A1:A2").font.Themecolor = xlThemeColorAccent1
        .Range("A1:A2").font.TintAndShade = -0.249977111117893
            
        xlObj.Cells.select
        .Cells.WrapText = False
        .Cells.EntireColumn.AutoFit
        .Cells.Rows.AutoFit
            
        xlObj.Range("A5").select
    End With

    wba.SaveAs strOutputToPath, CreateBackup:=False
' xlObj.ActiveWorkbook.SaveAs strOutputToPathCDrive, CreateBackup:=False
                    
    DoCmd.Hourglass False
    DoCmd.Echo False
    xlObj.Visible = True
    xlObj.Worksheets(1).select
    xlObj.Range("A5").select
    DoCmd.Echo True

Else
    With wba.Worksheets(1)
        .Range("A1").Value = "For Dates:  " & DMin("[Quality_Review_Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Quality_Review_Date]", "tblErrorDetails (for Report)")
        .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"

        With .Range("A1:A2").font
            .Bold = True
            .Themecolor = xlThemeColorAccent1
            .TintAndShade = -0.249977111117893
        End With
        
        lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Range("B" & lRow + 1).Formula = "=Sum(B5:B" & lRow & ")"
        .Range("B" & lRow + 1).font.Bold = True
        .Range("A" & lRow + 1).Value = "TOTAL ERRORS"
        .Range("A" & lRow + 1).font.Bold = True
        .Range("A" & lRow + 1).HorizontalAlignment = xlRight
        .Range("A" & lRow + 1).VerticalAlignment = xlBottom
        .Range("A" & lRow + 1).font.Color = -16776961
    End With
    
    With wba.Worksheets(1).Range("B" & lRow).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With wba.Worksheets(1)
        lRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        .Range("C" & lRow + 1).Formula = "=Sum(C5:C" & lRow & ")"
        .Range("C" & lRow + 1).font.Bold = True
    End With
    
    With wba.Worksheets(1).Range("C" & lRow).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With wba.Worksheets(1)
        lRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        .Range("D" & lRow + 1).Formula = "=Sum(D5:D" & lRow & ")"
        .Range("D" & lRow + 1).font.Bold = True
    End With
    
    With wba.Worksheets(1).Range("D" & lRow).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
        
        xlObj.Columns("D:D").select
        xlObj.Columns.NumberFormat = "General"
    End With

    With wba.Worksheets(2)
        .Range("A1").Value = "For Dates:  " & DMin("[Quality_Review_Date]", "tblErrorDetails (for Report)") & " thru " & DMax("[Quality_Review_Date]", "tblErrorDetails (for Report)")
        .Range("A2").Value = "Filtered By:" & " " & cboReportCateg & " " & "(" & cboCategSelect & ")"

        With .Range("A1:A2").font
            .Bold = True
            .Themecolor = xlThemeColorAccent1
            .TintAndShade = -0.249977111117893
        End With
        
        xlObj.Cells.select
        .Cells.WrapText = False
        .Cells.EntireColumn.AutoFit
        .Cells.Rows.AutoFit
        
        xlObj.Range("A5").select
    End With
                    
    xlObj.ActiveWorkbook.SaveAs strOutputToPath, CreateBackup:=False
'   xlObj.ActiveWorkbook.SaveAs strOutputToPathCDrive, CreateBackup:=False

    DoCmd.Hourglass False
    DoCmd.Echo False
    xlObj.Visible = True
    wba.Worksheets(1).select
    xlObj.Range("A5").select
    DoCmd.Echo True
End If

Else
'if table "tblErrorDetails (for Report)" contains no data
MsgBox "There are no results for the selected criteria. Please revise your criteria, and try again.", vbOKOnly
Me.cboCategSelect.SetFocus
End If

DoCmd.SetWarnings True
DoCmd.Echo True
DoCmd.Hourglass False

Exit_Err_cmdDetErrRpt_Click:
Exit Sub

Err_cmdDetErrRpt_Click:
If Err.Number = 2501 Then
    'no action required - ignore the error - because opening of report was cancelled
Else
'Call MyRaiseError(Err.Number, Err.Description)
   MsgBox Err.Description
Resume Exit_Err_cmdDetErrRpt_Click
End If

'GoTo Exit_Err_cmdDetErrRpt_Click

Me.cboCategSelect = Null
Me.cboReportCateg = Null
Me.txtBeginDT = Null
Me.txtEndDT = Null
Me.cboDept = Null

Open in new window