• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 3860
  • Last Modified:

VBA add gridlines to Excel Spreadsheet

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

0
Michael Vasilevsky
Asked:
Michael Vasilevsky
  • 2
1 Solution
 
JimFiveCommented:
I would guess that you need to use something like
With WorkbookObject.Range("A1:U78")

...

0
 
Rey Obrero (Capricorn1)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


0
 
Michael VasilevskySolutions ArchitectAuthor 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

0
 
Michael VasilevskySolutions ArchitectAuthor 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
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

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.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now