Go Back  Xtreme Visual Basic Talk > Legacy Visual Basic (VB 4/5/6) > VBA / Office Integration > Word, PowerPoint, Outlook, and Other Office Products > Problems Creating Pivot tables in Excel with vb


Reply
 
Thread Tools Display Modes
  #1  
Old 04-15-2003, 05:43 AM
aine aine is offline
Newcomer
 
Join Date: Apr 2003
Posts: 1
Question Problems Creating Pivot tables in Excel with vb


Hi I am having problems creating a Pivot Table from VB code. My Code below runs a database query and returns the results to a Recordset,
It then puts the contents of the recordset into an excel worksheet (Sheet1), this works fine even though i have a feeling I went a roundabout method of doing it.

I Now Want to take the used Range in Sheet1 and create a pivot Table in Sheet2. I Have Tried See below, but I am getting the following errors:

:Reference not valid
:Application Defined or Object Defined error

I would greatly appriciate if anyone could Tell me Where I am going wrong.


***CODE***Private PGDB As Database
Private rs As Recordset
Dim sPath As String
Dim strXPath As String
Dim strSQL As String
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht1 As Excel.Worksheet
Dim xlSht2 As Excel.Worksheet
Dim PTable As Excel.PivotTable
Dim PCache As Excel.PivotCache
Dim PField As Excel.PivotField

Private Sub CmdEnter_Click()
On Error GoTo Err_CmdEnter_Click


'Path to Access Database
sPath = "C:\Databases\Database1.mdb"

'Path to Excel File
strXPath = "C:\Reports\TEST.xls"


strSQL = "SELECT CUSTOMERS.[Customer_Account No], CUSTOMERS.[Customer_Name], CUSTOMERS.[Customer_Address2], CUSTOMERS.[Customer_Address3], CUSTOMERS.[Customer_Address_4], SALES.Occasion, SALES.Title, SALES.[Price_Band], Sum(SALES.Invoice_Quantity) As QTY, Sum(SALES.Gross_Goods_Value) As Gross " & _
"FROM CUSTOMERS INNER JOIN SALES ON CUSTOMERS.[Customer_Account No]=SALES.[Customer_Account No]" & _
"WHERE(((CUSTOMERS.[Customer_Account No])= """ & CboNumber & """) And ((SALES.Invoice_Date) Between #" & TxtFrom & "# And #" & TxtTo & "#))" & _
"GROUP BY CUSTOMERS.[Customer_Account No], CUSTOMERS.Customer_Name, CUSTOMERS.Customer_Address2, CUSTOMERS.Customer_Address3, CUSTOMERS.Customer_Address_4, SALES.Title, SALES.Price_Band, SALES.Occasion;"


'Open database, Run Query and return results to recordset
Set PGDB = OpenDatabase(sPath)
Set rs = PGDB.OpenRecordset(strSQL)


'Open Excel
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Open(strXPath)
Set xlSht1 = xlWkb.Worksheets("Sheet1")
Set xlSht2 = xlWkb.Worksheets("Sheet2")

xlSht1.Activate


'Enter column headingings in excel file
Range("A1") = "Customer_Account No"
Range("B1") = "Customer_Name"
Range("C1") = "Customer_Address2"
Range("D1") = "Customer_Address3"
Range("E1") = "Customer_Address_4"
Range("F1") = "Occasion"
Range("G1") = "Title"
Range("H1") = "Price_Band"
Range("I1") = "QTY"
Range("J1") = "Gross"


'Enter data from recordset into excel file,
'this is working, but if anyone knows a better way

Dim intI As Integer
Dim strCell As String
intI = 2

Do While Not rs.EOF
strCell = "" & intI & ""
Range("A" & strCell) = rs.Fields("Customer_Account No")
Range("B" & strCell) = rs.Fields("Customer_Name")
Range("C" & strCell) = rs.Fields("Customer_Address2")
Range("D" & strCell) = rs.Fields("Customer_Address3")
Range("E" & strCell) = rs.Fields("Customer_Address_4")
Range("F" & strCell) = rs.Fields("Occasion")
Range("G" & strCell) = rs.Fields("Title")
Range("H" & strCell) = rs.Fields("Price_Band")
Range("I" & strCell) = rs.Fields("QTY")
Range("J" & strCell) = rs.Fields("Gross")

rs.MoveNext
intI = intI + 1
Loop

'Close Recordset and Database
rs.Close
PGDB.Close

'Find the last Row in the excel worksheet
Dim LastRow As Integer

If xlApp.WorksheetFunction.CountA(Worksheets("Sheet1").Cells) = 0 Then
LastRow = 1
Else
LastRow = Worksheets("Sheet1").UsedRange.Rows.Count + Worksheets("Sheet1").UsedRange.Row

While Application.WorksheetFunction.CountA(Worksheets("Sheet1").Rows(LastRow )) = 0
LastRow = LastRow - 1
Wend
End If


'Use LastRow to find range for pivot table
Dim strRange As String
strRange = "A1J1:A" & "" & LastRow & "" & "J" & "" & LastRow & ""


'Build Pivot Table, the code is working up to here
'I am getting a "Reference Not Valid" Error and
'A Application Defined and Object Defined error

PCache = xlWkb.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=strRange).CreatePivotTable(TableDestination:=xlSht2.Cells( 5, 1), TableName:="Sales Analysis")
PTable = xlSht2.PivotTable("Sales Analysis")

With xlSht2.PivotTables("Sales Analysis")
PField = PTable.PivotFields("Occasion")
PField.Orientation = xlRowField
End With

With xlSht2.PivotTables("Sales Analysis")
PField = PTable.PivotFields("Title")
PField.Orientation = xlRowField
End With

With xlSht2.PivotTables("Sales Analysis")
PField = PTable.PivotFields("Price_Band")
PField.Orientation = xlColumnField
End With

With xlSht2.PivotTables("Sales Analysis")
PField = PTable.PivotFields("Customer_Account No")
PField.Orientation = xlPageField
End With

With xlSht2.PivotTables("Sales Analysis")
PField = PTable.PivotFields("QTY")
PField.Orientation = xlDataField
End With

With xlSht2.PivotTables("Sales Analysis")
PField = PTable.PivotFields("Gross")
PField.Orientation = xlDataField
End With


'Open excel to view pivot table
xlSht2.Activate
xlApp.Visible = True



Exit_CmdEnter_Click:
Exit Sub

Err_CmdEnter_Click:
MsgBox Err.Description
Resume Exit_CmdEnter_Click

End Sub
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Creating Pivot Tables automatically Warfy Word, PowerPoint, Outlook, and Other Office Products 1 03-12-2003 02:21 PM
Creating tables in VB dpdsouza Database and Reporting 5 10-17-2002 12:49 AM
QB to VB Conversion - By AIO BillSoo Tutors' Corner 0 08-06-2002 11:37 AM
Excel page setup problems using vb vbenito Word, PowerPoint, Outlook, and Other Office Products 6 05-09-2002 01:38 PM
Excel Pivot Tables pukleja Word, PowerPoint, Outlook, and Other Office Products 2 03-05-2002 06:21 PM

Advertisement:





Free Publications
The ASP.NET 2.0 Anthology
101 Essential Tips, Tricks & Hacks - Free 156 Page Preview. Learn the most practical features and best approaches for ASP.NET.
subscribe
Programmers Heaven C# School Book -Free 338 Page eBook
The Programmers Heaven C# School book covers the .NET framework and the C# language.
subscribe
Build Your Own ASP.NET 3.5 Web Site Using C# & VB, 3rd Edition - Free 219 Page Preview!
This comprehensive step-by-step guide will help get your database-driven ASP.NET web site up and running in no time..
subscribe
 
 
-->