Advertisement
Advertisement
| 03.18.2008 at 08:31AM PDT, ID: 23250553 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
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
|