We help IT Professionals succeed at work.

VBA add gridlines to Excel Spreadsheet

Michael Vasilevsky
on
I'm using the below code in an Access module to add gridlines to an Excel spreadsheet but it doesn't work (no gridlines added).
How to do it?
With Range("A1:U78")
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
            End With
            With Range("A1:U78").Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Range("A1:U78").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Range("A1:U78").Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Range("A1:U78").Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Range("A1:U78").Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With

Open in new window

Comment
Watch Question

Commented:
I would guess that you need to use something like
With WorkbookObject.Range("A1:U78")

...

CERTIFIED EXPERT
Top Expert 2016
Commented:
try this

Sub formatXl()
Dim xlObj As Object
Set xlObj = CreateObject("Excel.Application")
    xlObj.Workbooks.Add
    xlObj.ActiveWorkbook.Sheets("sheet1").Select
    With xlObj
            With .Range("A1:U78")
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
            End With
            With .Range("A1:U78").Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A1:U78").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A1:U78").Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A1:U78").Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A1:U78").Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
           
            .ActiveWorkbook.SaveAs "C:\myFormat.xls"
    End With
    xlObj.Quit
    Set xlObj = Nothing
End Sub


Michael VasilevskySolutions Architect
CERTIFIED EXPERT

Author

Commented:
Cap, your code works fine, however when I run my subroutine I get the following error: Method 'Range' of object '_Global' failed. I can comment out the gridlines section and run without issue.

I've attached my entire sub. See any issues?
Private Sub cmdOverviewReportExport_Click()
On Error GoTo Err_cmdOverviewRptExport_Click
 
    Dim stDocName As String
    
    stDocName = "rpt_OverviewforExport"
    DoCmd.OutputTo acReport, stDocName
 
    DoCmd.Hourglass True
    Dim xcelwb As Excel.Workbook
    Dim xcelapp As Excel.Application
    Dim Sheet As Excel.Worksheet
    Dim rng As Excel.Range
    Dim celle As Excel.Range
    Dim x As Integer
    Dim y As Integer
            
    Set xcelapp = New Excel.Application
    Set xcelwb = xcelapp.Workbooks.Open("rpt_OverviewforExport.xls")
    Set Sheet = xcelapp.ActiveWorkbook.Sheets(1)
    Sheet.Select
       
       '>>>>>>>>>>>>>>>>format the excel data>>>>>>>>>>>>>>>>>>>
       With Sheet
            'Make the column headers bold
            .Rows("1:1").Font.Bold = True
            'Format the dates
            .Columns("E:L").NumberFormat = "m/d/yyyy"
            'Set column widths
            .Columns("A:A").ColumnWidth = 14.29
            .Columns("B:B").ColumnWidth = 8.86
            .Columns("C:C").ColumnWidth = 14.29
            .Columns("D:D").ColumnWidth = 14.29
            .Columns("E:E").ColumnWidth = 14.29
            .Columns("F:Z").ColumnWidth = 8.86
            'Set row height
            .Rows(1).RowHeight = 25.5
            'Allow text wrapping
            .Columns("B:Z").WrapText = True
            'Add conditional formatting
            .Columns("F:Z").FormatConditions.Delete
            .Columns("F:Z").FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
                Formula1:="=TODAY()", Formula2:="1"
            .Columns("F:Z").FormatConditions(1).Interior.ColorIndex = 3
            .Columns("F:Z").FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
                Formula1:="=TODAY()", Formula2:="=TODAY()+14"
            .Columns("F:Z").FormatConditions(2).Interior.ColorIndex = 6
            
            y = 6 ' column number
            Do Until y = 26
                x = 2 'row number
                Do Until x = 30
                    Set rng = .Cells(x, y)
                    For Each celle In rng
                        If celle Like "*Approved*" Then
                            .Cells(celle.Row, celle.Column - 1).FormatConditions.Delete
                            .Cells(celle.Row, celle.Column - 1).Interior.ColorIndex = 4
                        End If
                    Next celle
                    x = x + 1
                Loop
                y = y + 2
            Loop
            'Delete Approval columns
            .Columns("G:G").Delete
            .Columns("H:H").Delete
            .Columns("I:I").Delete
            .Columns("J:J").Delete
            .Columns("K:K").Delete
            .Columns("L:L").Delete
            
            .Cells.EntireRow.AutoFit
            
            'set color of header cells
            .Cells(1, 1).Interior.ColorIndex = 15
            .Cells(1, 2).Interior.ColorIndex = 15
            .Cells(1, 3).Interior.ColorIndex = 15
            .Cells(1, 4).Interior.ColorIndex = 15
            .Cells(1, 5).Interior.ColorIndex = 15
            .Cells(1, 6).Interior.ColorIndex = 15
            .Cells(1, 7).Interior.ColorIndex = 15
            .Cells(1, 8).Interior.ColorIndex = 15
            .Cells(1, 9).Interior.ColorIndex = 15
            .Cells(1, 10).Interior.ColorIndex = 15
            .Cells(1, 11).Interior.ColorIndex = 15
            
            'set gridlines
            With Range("A1:050")
                .Borders(xlDiagonalDown).LineStyle = xlNone
                .Borders(xlDiagonalUp).LineStyle = xlNone
            End With
            With Range("A1:050").Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Range("A1:050").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Range("A1:050").Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Range("A1:050").Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Range("A1:050").Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            
            'setup page margins, orientation, and to fit 1x1 page
            With .PageSetup
                .LeftHeader = ""
                .CenterHeader = ""
                .RightHeader = ""
                .LeftFooter = "Printed: " & Date
                .CenterFooter = ""
                .RightFooter = ""
                .LeftMargin = 0.5
                .RightMargin = 0.5
                .TopMargin = 0.75
                .BottomMargin = 0.75
                .HeaderMargin = 0.75
                .FooterMargin = 0.75
                .PrintHeadings = False
                .PrintGridlines = True
                .PrintComments = xlPrintNoComments
                .PrintQuality = 600
                .CenterHorizontally = True
                .CenterVertically = True
                .Orientation = xlLandscape
                .Draft = False
                .PaperSize = xlPaperLetter
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = False
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = 1
                .PrintErrors = xlPrintErrorsDisplayed
             End With
        'Set focus
        .Cells(1, 1).Select
    End With
       
    DoCmd.Hourglass False
    xcelwb.Close True
    xcelapp.Quit
    Set xcelapp = Nothing
    Set xcelwb = Nothing
    Set Sheet = Nothing
    Set rng = Nothing
    
Exit_cmdOverviewRptExport_Click:
    Exit Sub
 
Err_cmdOverviewRptExport_Click:
    MsgBox "Form: frm_Documents, cmdOverviewRptExport_Click " & Err.Description
    DoCmd.Hourglass False
    'xcelwb.Close True
    xcelapp.Quit
    Set xcelapp = Nothing
    Set xcelwb = Nothing
    Set Sheet = Nothing
    Set rng = Nothing
    Resume Exit_cmdOverviewRptExport_Click
End Sub

Open in new window

Michael VasilevskySolutions Architect
CERTIFIED EXPERT

Author

Commented:
Huh I copy and pasted what you had in your routine and it works not although I can't see any difference in the code.

Scratching my head but hey, I get to cross this one off my list.
Thanks!

mv