G
gfranco
I have a project to elaborate, I have my base data and i need to convert it
onto Pivot TAble worksheet, let me know ho can I do it, thanks
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)
Set xlrng = xlws.Cells(3, 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:R646C16" & y & "C" &
x - 1, _
xlrng, "PartnerPivotTable", 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
onto Pivot TAble worksheet, let me know ho can I do it, thanks
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)
Set xlrng = xlws.Cells(3, 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:R646C16" & y & "C" &
x - 1, _
xlrng, "PartnerPivotTable", 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