Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Access/Excel VBA Question about my code.

Status
Not open for further replies.
RodgerDJr

RodgerDJr

MIS
Mar 8, 2002
15
US
All,

I have a Public Function in Access that will read from my tables and create a formatted Excel Spreadsheet. It works most of the time, other times I get errors at various spots Object variable or With block variable not set, Error 91, Application-defined or Object-defined error, Error 1004. I think it could be the way I am call Excel, but I am not sure this is my first attempt at doing this. I have do a lot of VBA programing in Access and have not done much in Excel in a long time.

If I change xlApp.Visible = True to False, I get Object variable or With block variable not set, Error 91 99% of the time.

Here is my code. I put a note in on the two lines I get the errors on sometimes. I can run this code a few times with out an issue and then I run it again without changing anything and I get on of the errors.

I am up for suggestions.

TIA,
Rodger

Code: 
Option Compare Database

Public Function CreateExcel(Optional myEmpoyeeNumber As Integer)

Dim xlApp As Object
Dim myMessage, myStyle, myTitle, myResult
Dim mySQL, myDB, myRS1, myRS2
Dim myColorIndex As Integer
Dim myColor, x, y, z
Dim myValue1, myValue2, myStatus1, myStatus2
Dim myProjectManager, myLeadAnalyst, myTSG, myEmpSQL

'On Error GoTo Err_CreateExcel

'Create Excel Workbook
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    xlApp.Workbooks.Add

    Set myDB = CurrentDb()
    mySQL = "SELECT * FROM dbo_CATEGORIES"
    
    Set myRS2 = myDB.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    
    x = 1
    y = 7
    z = xlApp.Worksheets(1).UsedRange.Rows.Count
    
    'Rename the sheet
    If Nz(myEmpoyeeNumber, "0") = "0" Then
        xlApp.Worksheets(1).Name = "All Projects"
    Else
        xlApp.Worksheets(1).Name = myEmpoyeeNumber
    End If
    
    Do Until myRS2.EOF
        myColorIndex = myRS2!CAT_COLOR_INDEX
        xlApp.Worksheets(1).Cells(x, y).Select
            With Selection
                .Interior.ColorIndex = myColorIndex  [COLOR=red]'<< Runtime 91 sometimes[/color]
                .Interior.Pattern = xlSolid
            End With
        xlApp.Worksheets(1).Cells(x, y + 1).Value = myRS2.CAT_DESCRIPTION
        x = x + 1
        myRS2.MoveNext
    Loop
    
'Create the headers
    xlApp.Worksheets(1).Cells(1, 2).Value = "INFORMATION SYSTEMS PROJECTS"
    xlApp.Worksheets(1).Cells(1, 3).Value = Date

    xlApp.Worksheets(1).Cells(6, 2).Value = "Project"
    xlApp.Worksheets(1).Cells(6, 3).Value = "Customer"
    xlApp.Worksheets(1).Cells(6, 4).Value = "Original Hours Estimated"
    xlApp.Worksheets(1).Cells(6, 5).Value = "Actual Hours Expended"
    xlApp.Worksheets(1).Cells(6, 6).Value = "Estimated Hours Remaining"
    xlApp.Worksheets(1).Cells(6, 7).Value = "Original Target Completion"
    xlApp.Worksheets(1).Cells(6, 8).Value = "New Target Completion"
    xlApp.Worksheets(1).Cells(6, 9).Value = "Resources"
    xlApp.Worksheets(1).Cells(6, 10).Value = "Comments"
        
    xlApp.Worksheets(1).Cells(7, 3).Select
    ActiveWindow.FreezePanes = True
    
    Rows("6:6").RowHeight = 33.75
    
    Columns("A:A").ColumnWidth = 3
    Columns("B:B").ColumnWidth = 49.43
    Columns("C:C").ColumnWidth = 27.29
    Columns("D:D").ColumnWidth = 10
    Columns("E:E").ColumnWidth = 11.14
    Columns("F:F").ColumnWidth = 12.57
    Columns("G:G").ColumnWidth = 11.86
    Columns("H:H").ColumnWidth = 14.29
    Columns("I:I").ColumnWidth = 32
    Columns("J:J").ColumnWidth = 12
    
    xlApp.Worksheets(1).Range(Cells(6, 2), Cells(6, 10)).Select  [COLOR=red]'<< Runtime 1004 sometimes [/color]
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    If IsNull(myEmpoyeeNumber) Or myEmpoyeeNumber = 0 Then
        myEmpSQL = ""
    Else
        myEmpSQL = "AND ((PM.EMP_NUMBER)=" & myEmpoyeeNumber & ") OR (((LAN.EMP_NUMBER)=" & myEmpoyeeNumber & ")) OR (((TSG.EMP_NUMBER)=" & myEmpoyeeNumber & ")) OR (((EmployeeSingleLineNumber([P].[PRO_ID])) In ('" & myEmpoyeeNumber & "'))) "
    End If

    mySQL = "SELECT S.STA_ID, S.STA_DESCRIPTION, P.PRO_LINE_NUMBER, P.PRO_NAME, C.CAT_DESCRIPTION, C.CAT_COLOR_INDEX, C.CAT_COLOR, PP.PAP_ID, PP.PAP_DESCRIPTION, PM.NAME_LF AS PROJECT_MANAGER, LAN.NAME_LF AS LEAD_ANALYST, TSG.NAME_LF AS TSG, PHO.PROJECT_HOURS_ORIGINAL, PHC.PROJECT_HOURS_CURRENT, PSDO.PROJECT_START_DATE_ORIGINAL, PSDC.PROJECT_START_DATE_CURRENT, P.PRO_ORIGINAL_DATE, CustomerSingleLine(P.PRO_ID) AS CUSTOMER, EmployeeSingleLine(P.PRO_ID) AS RESOURCES, PH.HOURS, PH.HOURS_EXPENDED, PH.HORS_LEFT, PM.EMP_NUMBER AS PROJECT_MANAGER_NUMBER, LAN.EMP_NUMBER AS LEAD_ANALYST_NUMBER, TSG.EMP_NUMBER AS TSG_NUMBER, EmployeeSingleLineNumber([P].[PRO_ID]) AS RESOURCES_NUMBER " & _
            "FROM ((((((((((dbo_PROJECTS AS P LEFT JOIN qry_Project_Hours_Current AS PHC ON P.PRO_ID = PHC.PRH_PRO_ID) LEFT JOIN qry_Project_Hours_Original AS PHO ON P.PRO_ID = PHO.PRH_PRO_ID) LEFT JOIN qry_Project_Start_Date_Original AS PSDO ON P.PRO_ID = PSDO.PSD_PRO_ID) LEFT JOIN qry_Project_Start_Date_Current AS PSDC ON P.PRO_ID = PSDC.PSD_PRO_ID) LEFT JOIN qry_Employee_Names AS PM ON P.PRO_PM_ID = PM.EMP_NUMBER) LEFT JOIN qry_Employee_Names AS LAN ON P.PRO_LAN_ID = LAN.EMP_NUMBER) LEFT JOIN qry_Employee_Names AS TSG ON P.PRO_TSG_ID = TSG.EMP_NUMBER) LEFT JOIN dbo_PARENT_PROJECTS AS PP ON P.PRO_PAP_ID = PP.PAP_ID) LEFT JOIN dbo_STATUS AS S ON P.PRO_STA_ID = S.STA_ID) LEFT JOIN dbo_CATEGORIES AS C ON P.PRO_CAT_ID = C.CAT_ID) LEFT JOIN qry_ProjectHours_Step3 AS PH ON P.PRO_ID = PH.PRO_ID " & _
            "WHERE ((P.PRO_LINE_NUMBER)<>'1000') " & myEmpSQL & _
            "ORDER BY S.STA_ID, P.PRO_LINE_NUMBER, P.PRO_NAME;"

    
    Set myRS1 = myDB.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    
    x = 7
    y = 1
    myStatus1 = myRS1!STA_DESCRIPTION
    
    Do Until myRS1.EOF
        
            If myStatus1 <> myStatus2 Then
                xlApp.Worksheets(1).Cells(x, y + 1).Value = myStatus1
                xlApp.Worksheets(1).Cells(x, y + 1).Select
                    With Selection
                        .Font.Bold = True
                        .HorizontalAlignment = xlCenter
                    End With
                x = x + 1
            Else
                'Does the project have a status if yes put the color index in the first cell for the row.
                If IsNull(myRS1!CAT_COLOR_INDEX) Then
                
                Else
                    myColorIndex = myRS1!CAT_COLOR_INDEX
                    'xlApp.Worksheets(1).Range(Cells(x, y), Cells(x, y)).Select
                    xlApp.Worksheets(1).Cells(x, y).Select
                        With Selection
                            .Interior.ColorIndex = myColorIndex
                            .Interior.Pattern = xlSolid
                        End With
                End If
            
                'Start listing out the project.
                xlApp.Worksheets(1).Cells(x, y + 1).Value = myRS1!PRO_LINE_NUMBER & " - " & myRS1!PRO_NAME
                xlApp.Worksheets(1).Cells(x, y + 2).Value = myRS1!CUSTOMER
                xlApp.Worksheets(1).Cells(x, y + 3).Value = myRS1!HOURS
                xlApp.Worksheets(1).Cells(x, y + 4).Value = myRS1!HOURS_EXPENDED
                xlApp.Worksheets(1).Cells(x, y + 5).Value = myRS1!HORS_LEFT
                xlApp.Worksheets(1).Cells(x, y + 6).Value = myRS1!PROJECT_START_DATE_ORIGINAL
                xlApp.Worksheets(1).Cells(x, y + 7).Value = myRS1!PROJECT_START_DATE_CURRENT
                'Get Project Manager, Lead Analyst, TSG ro add to the resources section
                    
                    If IsNull(myRS1!PROJECT_MANAGER) Or myRS1!PROJECT_MANAGER = "" Then
                        myProjectManger = ""
                    Else
                        If IsNull(myRS1!RESOURCES) Or myRS1!RESOURCES = "" Then
                            myProjectManger = myRS1!PROJECT_MANAGER
                        Else
                            myProjectManger = myRS1!PROJECT_MANAGER & ", "
                        End If
                    End If
                    
                    If IsNull(myRS1!LEAD_ANALYST) Or myRS1!LEAD_ANALYST = "" Then
                        myLeadAnalyst = ""
                    Else
                        If IsNull(myRS1!RESOURCES) Or myRS1!RESOURCES = "" Then
                            myLeadAnalyst = myRS1!LEAD_ANALYST
                        Else
                            myLeadAnalyst = myRS1!LEAD_ANALYST & ", "
                        End If

                    End If
                    
                    If IsNull(myRS1!TSG) Or myRS1!TSG = "" Then
                        myTSG = ""
                    Else
                        If IsNull(myRS1!RESOURCES) Or myRS1!RESOURCES = "" Then
                            myTSG = myRS1!TSG
                        Else
                            myTSG = myRS1!TSG & ", "
                        End If
                    End If
                
                
                xlApp.Worksheets(1).Cells(x, y + 8).Value = myProjectManager & myLeadAnalyst & myTSG & myRS1!RESOURCES
                
                'xlApp.Worksheets(1).Cells(x, y + 1).Select
                
            End If
    x = x + 1
    y = 1
    myStatus1 = myRS1!STA_DESCRIPTION
    myRS1.MoveNext
        
        If myRS1.EOF Then
        Else
            myStatus2 = myRS1!STA_DESCRIPTION
        End If
        'MsgBox ("myStatus1 = " & myStatus1 & vbCrLf & "myStatus2 = " & myStatus2)
    Loop
    
    'Right align hours
    xlApp.Worksheets(1).Range(Cells(8, 4), Cells(x, 6)).Select
        With Selection
            .HorizontalAlignment = xlRight
        End With
    'Date format
    xlApp.Worksheets(1).Range(Cells(8, 7), Cells(x, 8)).Select
        Selection.NumberFormat = "m/d/yyyy;@"
    'Wrap text for Resources
    xlApp.Worksheets(1).Range(Cells(8, 9), Cells(x, 9)).Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    z = xlApp.Worksheets(1).UsedRange.Rows.Count
    xlApp.Worksheets(1).Cells(7, 3).Select
        MsgBox "Export Completed.  Number of rows " & z
        xlApp.Visible = True
        
Set xlApp = Nothing
        
Exit_CreateExcel:
    Exit Function
    
Err_CreateExcel:
        Beep
        MsgBox Err.Number & " - " & Err.Description
        'Resume Exit_CreateExcel
        Exit Function
           
End Function
 
Sort by date Sort by votes

some of your Excel references are ambiguous, like the COLUMN() reference to NOTHING except what the Access editor can GUESS.

I would suggest that EVERY reference to the newly created Excel WORKBOOK be explicit via the With...End With statement...
Code: 
'
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False


    Set myDB = CurrentDb()
    mySQL = "SELECT * FROM dbo_CATEGORIES"
    
    Set myRS2 = myDB.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    
    With xlApp.Workbooks.Add
        x = 1
        y = 7
        Z = .Worksheets(1).UsedRange.Rows.Count
        
        'Rename the sheet
        If Nz(myEmpoyeeNumber, "0") = "0" Then
            .Worksheets(1).Name = "All Projects"
        Else
            .Worksheets(1).Name = myEmpoyeeNumber
        End If
        
        Do Until myRS2.EOF
            myColorIndex = myRS2!CAT_COLOR_INDEX
            
            With .Worksheets(1).Cells(x, y)
                .Interior.ColorIndex = myColorIndex  '<< Runtime 91 sometimes
                .Interior.Pattern = xlSolid
            End With
                
            .Worksheets(1).Cells(x, y + 1).Value = myRS2.CAT_DESCRIPTION
            x = x + 1
            myRS2.MoveNext
        Loop
'
'   and so on, referencing the previously created workbook
'   EVERY EXCEL REFERENCE should reference this WORKBOOK
'
'
'   Finally, save and close the workbook
        .SaveAs somePathAndName
        .Close
    End If

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
I am not sure what you mean my column() reference is to nothing. I am setting the column width at that point. Like I said I mostly work in Access VBA. I created most of this by recording a macro in Excel and then reviewing the source in Excel and adding it to my Access Code. Thanks . . . . Rodger
 
Upvote 0 Downvote

Code: 
    With xlApp.Workbooks.Add
        x = 1
        y = 7
        Z = .Worksheets(1).UsedRange.Rows.Count
        
        'Rename the sheet
        If Nz(myEmpoyeeNumber, "0") = "0" Then
            .Worksheets(1).Name = "All Projects"
        Else
            .Worksheets(1).Name = myEmpoyeeNumber
        End If
        
        Do Until myRS2.EOF
            myColorIndex = myRS2!CAT_COLOR_INDEX
            
            With .Worksheets(1).Cells(x, y)
                .Interior.ColorIndex = myColorIndex  '<< Runtime 91 sometimes
                .Interior.Pattern = xlSolid
            End With
                
            .Worksheets(1).Cells(x, y + 1).Value = myRS2.CAT_DESCRIPTION
            x = x + 1
            myRS2.MoveNext
        Loop
'
'   and so on, referencing the previously created workbook
'   EVERY EXCEL REFERENCE should reference this WORKBOOK
'[b]
       .Rows("6:6").RowHeight = 33.75
       
       .Columns("A:A").ColumnWidth = 3
       .Columns("B:B").ColumnWidth = 49.43
       .Columns("C:C").ColumnWidth = 27.29
       .Columns("D:D").ColumnWidth = 10
       .Columns("E:E").ColumnWidth = 11.14
       .Columns("F:F").ColumnWidth = 12.57
       .Columns("G:G").ColumnWidth = 11.86
       .Columns("H:H").ColumnWidth = 14.29
       .Columns("I:I").ColumnWidth = 32
       .Columns("J:J").ColumnWidth = 12

[/b]

'   Finally, save and close the workbook
        .SaveAs somePathAndName
        .Close
    End If

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
OK I did all of that now I am getting a 424 Runtime, Object Required.

Here is a the first half where it breaks.

Code: 
Public Function CreateExcel(Optional myEmpoyeeNumber As Integer)

Dim xlApp As Object
Dim myMessage, myStyle, myTitle, myResult
Dim mySQL, myDB, myRS1, myRS2
Dim myColorIndex As Integer
Dim myColor, x, y, z
Dim myValue1, myValue2, myStatus1, myStatus2
Dim myProjectManager, myLeadAnalyst, myTSG, myEmpSQL

'On Error GoTo Err_CreateExcel

'Create Excel Workbook
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    
    Set myDB = CurrentDb()
    mySQL = "SELECT * FROM dbo_CATEGORIES"
    
    Set myRS2 = myDB.OpenRecordset(mySQL, dbOpenDynaset, dbSeeChanges)
    
    With xlApp.Workbooks.Add
    x = 1
    y = 7
    z = .Worksheets(1).UsedRange.Rows.Count
    
    'Rename the sheet
    If Nz(myEmpoyeeNumber, "0") = "0" Then
        .Worksheets(1).Name = "All Projects"
    Else
        .Worksheets(1).Name = myEmpoyeeNumber
    End If
    
    Do Until myRS2.EOF
        myColorIndex = myRS2!CAT_COLOR_INDEX
        
            With .Worksheets(1).Cells(x, y).Select
     [COLOR=red] .Interior.ColorIndex = myColorIndex [/color]
                 .Interior.Pattern = xlSolid
            End With
        .Worksheets(1).Cells(x, y + 1).Value = myRS2.CAT_DESCRIPTION
        x = x + 1
        myRS2.MoveNext
    Loop

 
Upvote 0 Downvote
With .Worksheets(1).Cells(x, y).Select

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote


NO SELECT!!!

SELECT slows things down and is totally unnecessary in most coding situations!
Code: 
            With .Worksheets(1).Cells(x, y)
                  .Interior.ColorIndex = myColorIndex 
                 .Interior.Pattern = xlSolid
            End With


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
OK so then would I convert this
Code: 
    .Worksheets(1).Range(Cells(6, 2), Cells(6, 10)).Select
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
to this
Code: 
    With .Worksheets(1).Range(Cells(6, 2), Cells(6, 10))
     .Font.Bold = True
     .Borders(xlDiagonalDown).LineStyle = xlNone
     .Borders(xlDiagonalUp).LineStyle = xlNone
End With
 
Upvote 0 Downvote
I think I am getting this now.

So for this section I have a lot of With/End With Do I need to change those from this . .
Code: 
    With .Worksheets(1).Cells(7, 3)
        ActiveWindow.FreezePanes = True
    End With
    
    Rows("6:6").RowHeight = 33.75
    
    Columns("A:A").ColumnWidth = 3
    Columns("B:B").ColumnWidth = 49.43
    Columns("C:C").ColumnWidth = 27.29
    Columns("D:D").ColumnWidth = 10
    Columns("E:E").ColumnWidth = 11.14
    Columns("F:F").ColumnWidth = 12.57
    Columns("G:G").ColumnWidth = 11.86
    Columns("H:H").ColumnWidth = 14.29
    Columns("I:I").ColumnWidth = 32
    Columns("J:J").ColumnWidth = 12
    
    With .Worksheets(1).Range(Cells(6, 2), Cells(6, 10))
         .Font.Bold = True
         .Borders(xlDiagonalDown).LineStyle = xlNone
         .Borders(xlDiagonalUp).LineStyle = xlNone
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
To something more like this.
Code: 
    With .Worksheets(1).Cells(7, 3)
        ActiveWindow.FreezePanes = True
    End With
    
    Rows("6:6").RowHeight = 33.75
    
    Columns("A:A").ColumnWidth = 3
    Columns("B:B").ColumnWidth = 49.43
    Columns("C:C").ColumnWidth = 27.29
    Columns("D:D").ColumnWidth = 10
    Columns("E:E").ColumnWidth = 11.14
    Columns("F:F").ColumnWidth = 12.57
    Columns("G:G").ColumnWidth = 11.86
    Columns("H:H").ColumnWidth = 14.29
    Columns("I:I").ColumnWidth = 32
    Columns("J:J").ColumnWidth = 12
    
    With .Worksheets(1).Range(Cells(6, 2), Cells(6, 10))
         .Font.Bold = True
         .Borders(xlDiagonalDown).LineStyle = xlNone
         .Borders(xlDiagonalUp).LineStyle = xlNone
         
         .Borders(xlEdgeLeft)
         .LineStyle = xlContinuous
         .Weight = xlThin
         .ColorIndex = xlAutomatic

         .Borders(xlEdgeTop)
         .LineStyle = xlContinuous
         .Weight = xlThin
         .ColorIndex = xlAutomatic
    End With
 
Upvote 0 Downvote


ALL these statements need a reference to an Excel Sheet!!!
Code: 
    Rows("6:6").RowHeight = 33.75
  
    Columns("A:A").ColumnWidth = 3
    Columns("B:B").ColumnWidth = 49.43
    Columns("C:C").ColumnWidth = 27.29
    Columns("D:D").ColumnWidth = 10
    Columns("E:E").ColumnWidth = 11.14
    Columns("F:F").ColumnWidth = 12.57
    Columns("G:G").ColumnWidth = 11.86
    Columns("H:H").ColumnWidth = 14.29
    Columns("I:I").ColumnWidth = 32
    Columns("J:J").ColumnWidth = 12
so...
Code: 
   With .Worksheets(1)
    '[b]here's a place where a SELECT is required, prior to the FreezePanes method[/b]
        .Cells(7, 3).Select

        ActiveWindow.FreezePanes = True
    '[b]I assume that these row/columns are in Worksheets(1): hence the DOT reference[/b]
        .Rows("6:6").RowHeight = 33.75
    
        .Columns("A:A").ColumnWidth = 3
        .Columns("B:B").ColumnWidth = 49.43
        .Columns("C:C").ColumnWidth = 27.29
        .Columns("D:D").ColumnWidth = 10
        .Columns("E:E").ColumnWidth = 11.14
        .Columns("F:F").ColumnWidth = 12.57
        .Columns("G:G").ColumnWidth = 11.86
        .Columns("H:H").ColumnWidth = 14.29
        .Columns("I:I").ColumnWidth = 32
        .Columns("J:J").ColumnWidth = 12
    
        With .Range(Cells(6, 2), Cells(6, 10))
             .Font.Bold = True
             .Borders(xlDiagonalDown).LineStyle = xlNone
             .Borders(xlDiagonalUp).LineStyle = xlNone
    
             .Borders (xlEdgeLeft)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
    
             .Borders (xlEdgeTop)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
        End With
   End With

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Skip thanks for all your help on this.

I changed this to

Code: 
[COLOR=blue][b]    With .Worksheets(1)[/b][/color]
        .Cells(7, 3).Select
[COLOR=red]        ActiveWindow.FreezePanes = True [/color] << Runtime 91
    
        .Rows("6:6").RowHeight = 33.75
    
        .Columns("A:A").ColumnWidth = 3
        .Columns("B:B").ColumnWidth = 49.43
        .Columns("C:C").ColumnWidth = 27.29
        .Columns("D:D").ColumnWidth = 10
        .Columns("E:E").ColumnWidth = 11.14
        .Columns("F:F").ColumnWidth = 12.57
        .Columns("G:G").ColumnWidth = 11.86
        .Columns("H:H").ColumnWidth = 14.29
        .Columns("I:I").ColumnWidth = 32
        .Columns("J:J").ColumnWidth = 12

        With .Range(Cells(6, 2), Cells(6, 10))
             .Font.Bold = True
             .Borders(xlDiagonalDown).LineStyle = xlNone
             .Borders(xlDiagonalUp).LineStyle = xlNone
    
[COLOR=red]             .Borders (xlEdgeLeft)[/color]  << Getting an error here it does not like there is no select . . . LOL 
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
    
             .Borders (xlEdgeTop)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
        End With
[COLOR=blue][b]   End With << I have this End with to end the With from above[/b][/color]

 
Upvote 0 Downvote
[highlight].[/highlight]ActiveWindow.FreezePanes = True

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
Oops:
xlApp.ActiveWindow.FreezePanes = True

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote
Runtime 438 Object Does not support this property or method when I add the "dot
 
Upvote 0 Downvote

it NEEDS a reference to the Excel application object
Code: 
  xlApp.ActiveWindow.FreezePanes = True
or I might want to use
Code: 
  xlApp.Windows(1).FreezePanes = True
What is this statement DOING??? there is not OBJECT
Code: 
.Borders(xlEdgeLeft).[b][red]WhatGoesHere = ???????[/red][/b]

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
OK that fixed that . . .

[Code VBA\With .Worksheets(1).Range(Cells(6, 2), Cells(6, 10))</code>

I am getting a runtime 1004 Method 'Cells' of Object '_Global' failed. We fix one and break another one . . . .


 
Upvote 0 Downvote
OK that fixed that . . .

[Code VBA\With .Worksheets(1).Range(Cells(6, 2), Cells(6, 10))</code>

I am getting a runtime 1004 Method 'Cells' of Object '_Global' failed. We fix one and break another one . . . .


 
Upvote 0 Downvote
With .Range([highlight].[/highlight]Cells(6, 2), [highlight].[/highlight]Cells(6, 10))

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Upvote 0 Downvote


sorry, I missed this. [red]ALL[/red], [red]ALL[/red], [red]ALL[/red] Excel objects need a proper reference.
Code: 
 With .Worksheets(1)
'.......
       With .Range([b][red].[/red][/b]Cells(6, 2), [b][red].[/red][/b]Cells(6, 10))

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

M
  • Locked
  • Question
display a calendar with appointments in body of html email with access vba
Replies
1
Views
2K
SoftwareRT
SoftwareRT
Moss100
  • Locked
  • Question
Filter vba problem
Replies
1
Views
476
Andrzejek
Andrzejek
Omarahmed22
  • Locked
  • Question
VBA Formating
Replies
1
Views
411
Andrzejek
Andrzejek
DarkOne72
  • Locked
  • Question
MS Access DoCmd.Transferdatabase Assistance
Replies
2
Views
1K
lameid
lameid
Knicks
  • Locked
  • Question
Microsoft Access VBA Coding to Excel (early binding) 1
Replies
2
Views
695
Knicks
Knicks

Part and Inventory Search

Sponsor

Back
Top