Solved

VBA Code in Access Giving Errors on the Formatting

Posted on 2014-02-18
18
642 Views
Last Modified: 2014-03-11
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

0
Comment
Question by:gdunn59
  • 9
  • 4
  • 2
  • +1
18 Comments
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
Comment Utility
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

0
 

Author Comment

by:gdunn59
Comment Utility
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
0
 

Author Comment

by:gdunn59
Comment Utility
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
0
 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
Comment Utility
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.
0
 

Author Comment

by:gdunn59
Comment Utility
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
0
 

Author Comment

by:gdunn59
Comment Utility
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
0
 

Author Comment

by:gdunn59
Comment Utility
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

0
 
LVL 17

Expert Comment

by:andrewssd3
Comment Utility
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.
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 32

Expert Comment

by:Robberbaron (robr)
Comment Utility
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

0
 

Author Comment

by:gdunn59
Comment Utility
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
0
 
LVL 17

Expert Comment

by:andrewssd3
Comment Utility
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
0
 
LVL 32

Assisted Solution

by:Robberbaron (robr)
Robberbaron (robr) earned 300 total points
Comment Utility
true enough.

better would be removing the calls to Activesheet and xlObj.Selection where possible.
        With wbA 'xlObj
            '.Worksheets(1).Select
            
            '.ActiveSheet.Range("A5").Select
            Set rngA = .Worksheets(1).Range("A5")
            
            Set qdf = CurrentDb.QueryDefs("qryErrorDetails_Summary")
            Set rs = qdf.OpenRecordset
            rngA.CopyFromRecordset rs
            
            rs.Close
                
            '.Worksheets(2).Select
            '.ActiveSheet.Range("A5").Select
            Set rngA = .Worksheets(2).Range("A5")
            Set qdf2 = CurrentDb.QueryDefs("qryErrorDetails")
                        
            Set rs2 = qdf2.OpenRecordset
            rngA.CopyFromRecordset rs2
            rs2.Close
        End With

Open in new window


this has a bit of an advantage that it doesnt need to swap sheets and selection on screen though can make debugging harder sometimes, but easier as the VBA intelisense can help.
0
 

Author Comment

by:gdunn59
Comment Utility
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
0
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 300 total points
Comment Utility
1/ from an msdn comment...
Because ToArgb returns an integer.  The highest byte of this integer is the alpha (transparency) channel.  In many cases, the alpha value will make the integers sign bit be negative.
so the negative value should not be the problem.

2/ the real problem is probably that the constant xlThemeColorAccent1 is NOT defined in MSAccess.  you can get the actual value of this from the excel object browser.
its value is defined as 5 in XL07.  (xlThemeColorLight = 2)

the same could be true of xlRight = -4152, xlBottom = -4107 .
this may be corrected if you add a reference to MS Excel xx.0 Object Libary in your Access vba project. (Tools/References)  which is what andrewssd3 suggested above,
0
 

Author Comment

by:gdunn59
Comment Utility
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
0
 
LVL 32

Assisted Solution

by:Robberbaron (robr)
Robberbaron (robr) earned 300 total points
Comment Utility
1. error thrown... it could easily be the missing xlRight & xlBottom constants used on line 6 &7. it would assume these = zero and throw error.

one way to force the issue is to set Option Explicit, whuich forces every variable used to be declared. ie dim   other is to add them all. http://www.smarterdatacollection.com/Blog/?p=374


2. Constant in Object Viewer... open Excel, Visual Basic. View... object Browser.  type the desired value into the search box.  eg xlThemeColor.  then press the search button. it will list all the xlThemeColor constants.

const xlRight = -4152
const xlBottom = -4107
const xlThemeColorAccent1  = 5


                    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

0
 

Author Comment

by:gdunn59
Comment Utility
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

0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now