Sub pivot_Acc2Xl()
Dim dbs_nm, ssql As String
Dim dbs_conn As ADODB.Connection
Dim dbs_rs As ADODB.Recordset
Dim pvt_tbl As PivotTable
Dim pvt_che As PivotCache
 
dbs_nm = "C:\Documents and Settings\Chandru\Desktop\test.mdb"
Set dbs_conn = New ADODB.Connection
Set dbs_rs = New ADODB.Recordset
With dbs_conn
.Provider = "Microsoft.jet.oledb.4.0"
.Open dbs_nm
End With
Set dbs_rs.ActiveConnection = dbs_conn
ssql = "Select * from table1"
dbs_rs.Open ssql
 
Set pvt_che = ThisWorkbook.PivotCaches.Add(xlExternal)
Set pvt_che.Recordset = dbs_rs
Set pvt_tbl = pvt_che.CreatePivotTable(Worksheets(3).Range("A1"))
 
With pvt_tbl
.SmallGrid = False
.AddFields Array("Stud Nm", "Class", "Kannada", "English", "Maths", "Science", "Social")
End With
 
With pvt_tbl
.CalculatedFields.Add "Marks Total", "=sum(Kannada+English+Maths+Science+Social)"
.CalculatedFields.Add "Percentages Total", "=Marks Total /600*100"
End With
 
With pvt_tbl
.ColumnGrand = False
.RowGrand = False
.InGridDropZones = False
.TableStyle2 = "PivotStyleLight17"
.DisplayFieldCaptions = True
End With
 
With pvt_tbl.PivotFields("Marks Total")
.Orientation = xlDataField
.NumberFormat = "#,##0.00"
.LayoutForm = xlTabular
End With
 
With pvt_tbl.PivotFields("Percentages Total")
.Orientation = xlDataField
.NumberFormat = "#,##0.00"
.LayoutForm = xlTabular
End With
 
On Error Resume Next
For i = 2 To pvt_tbl.PivotFields.Count
a = pvt_tbl.PivotFields(i).Name
With pvt_tbl.PivotFields(a)
.LayoutForm = xlTabular
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
Next
On Error GoTo 0
 
With pvt_tbl
.PivotFields("Stud Nm").LayoutBlankLine = True
.NullString = "0"
.ShowDrillIndicators = False
.ColumnGrand = False
.RowGrand = False
.InGridDropZones = False
.PivotFields("Sum of Marks Total").Caption = " Marks Total"
.PivotFields("Sum of Percentages").Caption = " Percentage"
.TableStyle2 = "PivotStyleLight17"
.DisplayFieldCaptions = True
End With
 
With pvt_tbl
pitm_cnt = pvt_tbl.PivotFields("Stud Nm").PivotItems.Count
For j = 1 To pitm_cnt
pitem = pvt_tbl.PivotFields("Stud Nm").PivotItems(j)
For i = 1 To pitm_cnt
pvtitem = pvt_tbl.PivotFields("Stud Nm").PivotItems(i)
If pvtitem = pitem Then
pvt_tbl.PivotFields("Stud Nm").PivotItems(pvtitem).Visible = True
Else
pvt_tbl.PivotFields("Stud Nm").PivotItems(pvtitem).Visible = False
End If
Next
.TableRange1.Offset(1, 0).Copy
add_sht (pitem)
For Each pvtfld In pvt_tbl.PivotFields("Stud Nm").PivotItems
pvtfld.Visible = True
Next
i = i + 1
 
Next
End With
 
Set pvt_che = Nothing
Set pvt_tbl = Nothing
Set dbs_conn = Nothing
Set dbs_rs = Nothing
End Sub
Sub add_sht(ByRef pitem As String)
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
ThisWorkbook.Worksheets(Worksheets.Count).Name = pitem
With ThisWorkbook.Worksheets(pitem)
 
.Range("A3").PasteSpecial xlPasteValuesAndNumberFormats
.Range("A2:I2") = Array("Stud Nm", "Class", "Kannada", "English", "Maths", "Science", "Social", "Marks", "Percentange")
.Range("A1") = "Progess Report of " & pitem
.Range("A1:I1").Merge
.Range("A1:I1").HorizontalAlignment = xlCenter
.Range("A1:I1").Font.ColorIndex = 45
.Range("A1").Font.Size = 15
.Range("A1").Font.Bold = True
.Range("A2:I2").Font.Bold = True
.Range("A2:I2").Font.ColorIndex = 55
.Range("A1").Select
.Columns.AutoFit
End With
 
With Worksheets(3)
Application.CutCopyMode = False
End With
End Sub