In the below code, how can I add grid-lines to the entire Excel sheet?
Set objApp = CreateObject("Excel.Application")
objApp.Visible = True
Set wb = objApp.Workbooks.Open("template.xls", True, False)
wb.Sheets(1).Rows(3).Delete
wb.Sheets(1).Range("A1").Value = title
'need to format column E & F as currency
Set objApp = Nothing
This is the long answer (the code Excel VBA generates when you record a Macro). You can definitely shorten this up. For instance, you don't need to set the .ColorIndex or .TintAndShade properties just to do a standard black [edit] border.
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
EDIT
For gridlines:
ActiveWindow.DisplayGridlines = True
you can also use:
Windows(1).DisplayGridlines = True
Try this:
ActiveWindow.DisplayGridlines = True
That should turn the gridlines on. And, of course, setting the property to False will turn them off.
Related
I recorded a macro to create a new Pivot Table style so that whenever I create a new worksheet, this Pivot Table Style is added as the default for the Workbook. However, it does not seem to work when I try to run it on a new workbook. At first, I thought it might be the names (i.e. Sheet1), but even when everything matches it errors out on the first line. I hate having to go in and add this new pivot table style to every report I make, so if anyone has any tips, I'd greatly appreciate it. I'm a complete novice at VBA, so if there are any suggestions for making this code shorter, that would be of great help too!
EDIT: The code does not have curly quotations - that was me renaming it for posting.
Additional Edit: This is the error I get:
VBA Error: Run-time error '5': invalid procedure call or arguement
When I hit Debug, it takes me to the first line of code, which is highlighted in yellow: ActiveWorkbook.TableStyles.Add (“Overview”)
Sub Overview_Pivot_Format()
'
' Overview_Pivot_Format Macro
'
'
ActiveWorkbook.TableStyles.Add (“Overview”)
With ActiveWorkbook.TableStyles(“Overview”)
.ShowAsAvailablePivotTableStyle = True
.ShowAsAvailableTableStyle = False
.ShowAsAvailableSlicerStyle = False
.ShowAsAvailableTimelineStyle = False
End With
ActiveWorkbook.DefaultPivotTableStyle = “Overview”
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlWholeTable).Borders(xlEdgeTop)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlWholeTable).Borders(xlEdgeBottom)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlWholeTable).Borders(xlEdgeLeft)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlWholeTable).Borders(xlEdgeRight)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlWholeTable).Borders(xlInsideVertical)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlWholeTable).Borders(xlInsideHorizontal)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlHeaderRow).Interior
.Color = 15658734
.TintAndShade = 0
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlHeaderRow).Borders(xlEdgeTop)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlHeaderRow).Borders(xlEdgeBottom)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlHeaderRow).Borders(xlEdgeLeft)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlHeaderRow).Borders(xlEdgeRight)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlHeaderRow).Borders(xlInsideVertical)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlHeaderRow).Borders(xlInsideHorizontal)
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlTotalRow).Font
.FontStyle = "Bold"
.TintAndShade = 0
.ThemeColor = xlThemeColorDark1
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlTotalRow).Interior
.Color = 6697728
.TintAndShade = 0
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlSubtotalRow1).Font
.FontStyle = "Bold"
.TintAndShade = 0
.ThemeColor = xlThemeColorDark1
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlSubtotalRow1).Interior
.Color = 6697728
.TintAndShade = 0
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlSubtotalRow2).Font
.FontStyle = "Bold"
.TintAndShade = 0
.ThemeColor = xlThemeColorDark1
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlSubtotalRow2).Interior
.Color = 6697728
.TintAndShade = 0
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlSubtotalRow3).Font
.FontStyle = "Bold"
.TintAndShade = 0
.ThemeColor = xlThemeColorDark1
End With
With ActiveWorkbook.TableStyles(“Overview”).TableStyleElements( _
xlSubtotalRow3).Interior
.Color = 6697728
.TintAndShade = 0
End With
End Sub
The below worked for me:
Sub Overview_Pivot_Format()
Dim ts As TableStyle, wb As Workbook
Set wb = ActiveWorkbook 'workbook to be updated
On Error Resume Next 'ignore error if no style found in next line
wb.TableStyles("OverView").Delete 'in case already present
On Error GoTo 0 'stop ignoring errors
Set ts = wb.TableStyles.Add("Overview") 'get a reference to the added style
With ts
.ShowAsAvailablePivotTableStyle = True
.ShowAsAvailableTableStyle = False
.ShowAsAvailableSlicerStyle = False
.ShowAsAvailableTimelineStyle = False
End With
wb.DefaultPivotTableStyle = ts
'set properties by calling the 3 subs below...
DoBorders ts.TableStyleElements(xlWholeTable)
DoInterior ts.TableStyleElements(xlHeaderRow), 15658734
DoBorders ts.TableStyleElements(xlHeaderRow)
DoInterior ts.TableStyleElements(xlTotalRow), 6697728
DoFont ts.TableStyleElements(xlTotalRow)
DoInterior ts.TableStyleElements(xlSubtotalRow1), 6697728
DoFont ts.TableStyleElements(xlSubtotalRow1)
DoInterior ts.TableStyleElements(xlSubtotalRow2), 6697728
DoFont ts.TableStyleElements(xlSubtotalRow2)
DoInterior ts.TableStyleElements(xlSubtotalRow3), 6697728
DoFont ts.TableStyleElements(xlSubtotalRow3)
End Sub
'next 3 sub take care of updating the styles...
Sub DoFont(tse As TableStyleElement)
With tse.Font
.FontStyle = "Bold"
.TintAndShade = 0
.ThemeColor = xlThemeColorDark1
End With
End Sub
Sub DoBorders(tse As TableStyleElement)
With tse.Borders() 'no need to set individually...
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
.LineStyle = xlNone
End With
End Sub
Sub DoInterior(tse As TableStyleElement, clr As Long)
With tse.Interior
.Color = clr
.TintAndShade = 0
End With
End Sub
I have a code that does a loop through a worksheets, if there is a value 2 inside a cell in column S, then I want to insert a row with a specific layout. I have the code, but it takes ages to complete. I've tried replacing .select function, but because I need a specific layout, I don't know how to avoid this.
LastRowMatchC = Worksheets("Compliance").Cells(Rows.Count, 1).End(xlUp).Row
Dim rngc As Range, rc As Long
Set rngc = Range("S8:S" & LastRowMatchC)
For rc = rngc.Count To 1 Step -1
If rngc(rc).Value = 2 Then
rngc(rc + 1).EntireRow.Insert
rngc(rc + 1).EntireRow.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Next rch
I am trying to use the following code which is run from MS Project to populate an xls sheet.
As part of that I want to set formating including some merging & font setting.
I have 2 issues:
1) "Application.CutCopyMode = False" runs ok in xls but fails when I use the code in MS Project
2) Formating set out is not applied to the cells but does not error
Any thoughts ?
Thanks
Terran
'add the task details from row i onwards
'Removes tasks that are complete and not valid such as roll ups
For Each t In pj.Tasks
If t.Rollup = False Then
If t.Milestone = True Then
If t.Text18 Like "" Then
If t.Text19 Like "" Then
i = i + 1
'merge the 1st 2 cells
'ActiveSheet.Range(i2, i4).Select
' https://learn.microsoft.com/en-us/office/troubleshoot/office-developer/select-cells-rangs-with-visual-basic
'ActiveSheet.Cells(i, 2).Select
'With Selection
' .HorizontalAlignment = xlLeft
' .VerticalAlignment = xlBottom
' .WrapText = False
' .Orientation = 0
' .AddIndent = False
' .IndentLevel = 0
' .ShrinkToFit = False
' .ReadingOrder = xlContext
' .MergeCells = True
'End With
'put the values in the cells & set font
ActiveSheet.Cells(i, 2).Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
' ------
ActiveSheet.Cells(i, 5).Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
'change number formnat
With Selection.NumberFormat = "d/m/yyyy"
End With
' ------
ActiveSheet.Cells(i, 6).Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
'change number formnat
With Selection.NumberFormat = "d/m/yyyy"
End With
' ------
ActiveSheet.Cells(i, 7).Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
'change number formnat
With Selection.NumberFormat = "d/m/yyyy"
End With
' ------
ActiveSheet.Cells(i, 8).Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
'change number formnat
With Selection.NumberFormat = "d/m/yyyy"
End With
' ------
ActiveSheet.Cells(i, 2).Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
'change number formnat
With Selection.NumberFormat = "d/m/yyyy"
End With
' ------
ActiveSheet.Cells(i, 9).Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
'change number formnat
With Selection.NumberFormat = "d/m/yyyy"
End With
' ------
ActiveSheet.Cells(i, 10).Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlHairline
End With
'change number formnat
With Selection.NumberFormat = "d/m/yyyy"
End With
xlSheet.Cells(i, 2).Value = t.Name
xlSheet.Cells(i, 5).Value = t.BaselineStart
xlSheet.Cells(i, 6).Value = t.BaselineFinish
xlSheet.Cells(i, 7).Value = t.Start
xlSheet.Cells(i, 8).Value = t.Finish
xlSheet.Cells(i, 9).Value = t.ActualStart
xlSheet.Cells(i, 10).Value = t.ActualFinish
'xlSheet.Cells(i, 11).Value = t.Notes
End If
End If
End If
End If
Next t
---- updated with more details ---
I have made a vba macro that works fine with Excel 2013, but have error with Excel 2016. The macro is very simple and is taken from "recorded macro": it set borders to some cells.
The problem (I suppose) is that cells included also filtered rows:
column_1
cells(1;1) = "aa"
cells(2;1) = 2
cells(3;1) = 1
cells(4;1) = 2
cells(5;1) = 1
cells(6;1) = 1
filtered with "1" on the first row
enter image description here
So running the following macro,
you have error '1004' on ".weight " row
enter image description here
Giving OK you have:
enter image description here
and if you stop the macro now and try to save the file,
you'll get an error:
enter image description here
Please note that this happens only with Excel 2016, Excel 2013 has no problems
This is the complete macro:
Option Explicit
Sub test()
Sheets(1).Select
Range("A1:A6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin ' ==>>>>ERROR HERE
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Please help
Thx
Change range and try:
Option Explicit
Sub test()
With ThisWorkbook.Worksheets("Sheet1").Range("A1:A6").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
I've been reading Microsoft documentation and it seems the selection is unneccesary. Try this:
sub test()
Range("A1:A6").Borders.LineStyle = xlNone
With Range("A1:A6").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin ' ==>>ERROR HERE
End With
End sub
You may have to throw ActiveWorksheet before the range or a Sheet( "Sheet1") depending on what sheet you are on when the macro runs. Hope this helps.
I am adding all borders to a certain range, In my case (A6:O6),in excel VBA, the below code works but I'd imagine there would have to be a shorter way to write it. I found a single line of code that puts a border around the whole selection but not around every cell.
Range("A6:O6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
You can use the below statements
Dim myRange As Range
Set myRange = Range("A6:O6")
With myRange.Borders
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Try this. It will add a border around every cell in the range A6:O6.
Sub Macro1()
Dim rng As Range
' Define range
Set rng = Range("A6:O6")
With rng.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 0
.TintAndShade = 0
End With
End Sub