Advertisement
Advertisement
| 03.18.2008 at 08:31AM PDT, ID: 23250553 |
|
[x]
Attachment Details
|
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: |
Public Sub PivotTableExportData()
Dim xlapp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlws As Excel.Worksheet
Dim xlrng As Excel.Range
Dim xlPivot As Excel.PivotTable
Dim adors As ADODB.Recordset
Dim adofld As ADODB.Field
Dim x, y, z As Integer
Set xlapp = New Excel.Application
xlapp.Visible = True
Set xlwb = xlapp.Workbooks.Add
Set xlws = xlwb.ActiveSheet
xlws.Name = "BaseData"
Set adors = New ADODB.Recordset
adors.Open "qryTotalByPartner", CurrentProject.Connection, adOpenStatic, adLockReadOnly
x = 1
For Each adofld In adors.Fields
xlws.Cells(1, x).Value = adofld.Name
x = x + 1
Next adofld
Set xlrng = xlws.Cells(2, 1)
xlrng.CopyFromRecordset adors
y = adors.RecordCount + 1
adors.Close
Set xlws = xlwb.Worksheets.Add
xlws.Name = "PartnerPivot"
Set xlrng = xlws.Range("A3")
xlws.PivotTableWizard Excel.xlDatabase, "BaseData!R1C1:R" & y & "C" & x - 1, _
xlrng, "SalesPivotTable", True, True, True, True
Set xlPivot = xlws.PivotTables("PartnerPivotTable")
xlPivot.AddFields "Customer", "Created"
With xlPivot.PivotFields("TotalCost")
.Orientation = Excel.xlDataField
.NumberFormat = "$#,##0.00"
End With
Set xlPivot = Nothing
Set xlrng = Nothing
Set xlws = Nothing
Set xlwb = Nothing
Set xlapp = Nothing
Set adofld = Nothing
Set adors = Nothing
End Sub
Public Sub PivotTableChartExportData()
Dim xlapp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlws As Excel.Worksheet
Dim xlrng As Excel.Range
Dim xlPivot As Excel.PivotTable
Dim adors As ADODB.Recordset
Dim adofld As ADODB.Field
Dim x, y, z As Integer
Set xlapp = New Excel.Application
xlapp.Visible = True
Set xlwb = xlapp.Workbooks.Add
Set xlws = xlwb.ActiveSheet
xlws.Name = "BaseData"
Set adors = New ADODB.Recordset
adors.Open "qryTotalByPartner", CurrentProject.Connection, adOpenStatic, adLockReadOnly
x = 1
For Each adofld In adors.Fields
xlws.Cells(1, x).Value = adofld.Name
x = x + 1
Next adofld
Set xlrng = xlws.Cells(2, 1)
xlrng.CopyFromRecordset adors
y = adors.RecordCount + 1
adors.Close
Set xlws = xlwb.Worksheets.Add
xlws.Name = "SalesPivot"
Set xlrng = xlws.Range("A3")
xlws.PivotTableWizard Excel.xlDatabase, "BaseData!R1C1:R" & y & "C" & x - 1, _
xlrng, "PartnerPivotTable", True, True, True, True
Set xlPivot = xlws.PivotTables("PartnerPivotTable")
xlPivot.AddFields "Customer", "Created"
'xlPivot.AddFields "LineofBusiness2", "ProductCategory"
With xlPivot.PivotFields("TotalCost")
.Orientation = Excel.xlDataField
.NumberFormat = "$#,##0.00"
End With
xlwb.Charts.Add
ActiveChart.SetSourceData xlrng
ActiveChart.Location Where:=Excel.xlLocationAsNewSheet
Set xlPivot = Nothing
Set xlrng = Nothing
Set xlws = Nothing
Set xlwb = Nothing
Set xlapp = Nothing
Set adofld = Nothing
Set adors = Nothing
End Sub
|