Excel/Vbscript: Formating, Pivot Tables And Conditional Formatting
Option Explicit
Public Sub Main(mySheet,params)
With mySheet.Cells(1,1).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 12
.Bold=True
End With
mySheet.Cells(2,1).Font.Bold=True
mySheet.Cells(3,1).Font.Bold=True
Const xlContinuous=1
Const xlNone=-4142
Const xlThin=2
Const xlAutomatic=-4105
Const xlDiagonalDown=5
Const xlDiagonalUp=6
Const xlEdgeLeft=7
Const xlEdgeTop=8
Const xlEdgeBottom=9
Const xlEdgeRight=10
Const xlInsideVertical=11
Const xlInsideHorizontal=12
Const xlDatabase = 1
Const xlPivotTableVersion10 = 1
Const xlPivotTableCurrent = -1
Const xlRowField=1
Const xlColumnField=2
Const xlSum = -4157
Const xlSolid = 1
' Put on the autofilter on the result set
Dim topBot
topBot=Split(mySheet.UsedRange.Address,":")
mySheet.Range("$A$5:" & topBot(1)).AutoFilter
For i=1 To 15
mySheet.Columns(i).EntireColumn.AutoFit
Next
With mySheet.Range("A5:C5")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Interior
.Pattern = xlSolid
.ColorIndex = 34
End With
End With
Dim i
' Make the pivot table
Dim myWorkbook,myCache,myTable,newName,pivotSheet
mySheet.Activate
Set myWorkbook=mySheet.Parent
newName="Work Days Pivot(" & myWorkbook.Sheets.Count & ")"
Set myCache=myWorkbook.PivotCaches.Add(xlDatabase,"'" & mySheet.Name & "'!A5:" & topBot(1))
Set myTable=myCache.CreatePivotTable("", newName,TRUE, xlPivotTableCurrent)
Set pivotSheet = myTable.Parent
pivotSheet.Name=newName
With myTable.PivotFields("Date")
.Orientation = xlRowField
.Position = 1
End With
With myTable.PivotFields("Location")
.Orientation = xlColumnField
.Position = 1
End With
myTable.AddDataField myTable.PivotFields("Is Working Day"), "Working Days", xlSum
With myTable
.ColumnGrand = False
.RowGrand = False
End With
Const xlBottom = -4107
Const xlGeneral = 1
Const xlContext = -5002
topBot=Split(pivotSheet.UsedRange.Address,":")
Dim col,cols
cols = Split(topBot(1),"$")
col=cols(1)
With pivotSheet.Range("A4:" & col & "4")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 45
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
' Fit here - before putting in borders
pivotSheet.Columns("A:" & col).AutoFit
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
topBot=Split(pivotSheet.UsedRange.Address,":")
With pivotSheet.Range("$B$5:" & topBot(1))
.FormatConditions.Delete
.FormatConditions.Add 1, 3,"1"
.FormatConditions(1).Interior.ColorIndex = 43
.FormatConditions.Add 1, 3,"0"
.FormatConditions(2).Interior.ColorIndex = 22
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End Sub
[Via]