Hi,
In the below code I have vba code which get student wise report using
pivot table. Here I need chart with report also.
Thanks in advance.
Sub pivot2_creation()
Dim pvt_che As PivotCache
Dim pvt_tbl As PivotTable
Set Rng = Sheet1.UsedRange
Set pvt_che = ThisWorkbook.PivotCaches.Create(xlDatabase, Rng)
Set pvt_tbl = pvt_che.CreatePivotTable(Worksheets(3).Range("A1"))
With pvt_tbl
.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", "=Marks Total/600*100"
End With
With pvt_tbl.PivotFields("Marks Total")
.Orientation = xlDataField
.NumberFormat = "#,##0.00"
End With
With pvt_tbl.PivotFields("Percentages")
.Orientation = xlDataField
.NumberFormat = "#,##0.00"
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(2, 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
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
Regards,
Chandra Shekar B
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 7000 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
