Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Solved

VBA Code in Access Giving Errors on the Formatting

Posted on 2014-02-18
18
655 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)
ID: 39868793
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39868817
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39868832
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
The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

 
LVL 47

Expert Comment

by:Dale Fye (Access MVP)
ID: 39869129
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39869325
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39869423
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39874970
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
ID: 39879080
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
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 39880233
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39881724
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
ID: 39881867
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
ID: 39881952
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39883089
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
ID: 39885213
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39886043
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
ID: 39888494
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39920906
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

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
It’s been over a month into 2017, and there is already a sophisticated Gmail phishing email making it rounds. New techniques and tactics, have given hackers a way to authentically impersonate your contacts.How it Works The attack works by targeti…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

791 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