Article ID: 183798
Article Last Modified on 6/17/2005
A1: Region B1: Office C1: Sales
A2: North B2: Alpha C2: 100
A3: East B3: Beta C3: 120
A4: West B4: Alpha C4: 130
A5: North B5: Beta C5: 100
A6: East B6: Beta C6: 140
A7: West B7: Alpha C7: 110
Then, save the workbook on the hard disk with the name Sales.
Sub Create_PivotTable()
Dim xlObj As Excel.Application
Err.Number = 0
On Error GoTo notLoaded
Set xlObj = GetObject(, "Excel.Application.8")
notLoaded:
If Err.Number = 429 Then
Set xlObj = CreateObject("Excel.Application.8")
theError = Err.Number
End If
xlObj.Visible = True
xlObj.Workbooks.Open FileName:="<Hard Drive Name>:Sales"
With xlObj
.Range("A1").Select
.ActiveSheet.PivotTableWizard SourceType:=xlDatabase, _
SourceData:= "Sheet1!R1C1:R5C3", TableDestination:="", _
TableName:="PivotTable1"
.ActiveSheet.PivotTables("PivotTable1").AddFields _
RowFields:="Office", ColumnFields:="Region"
.ActiveSheet.PivotTables("PivotTable1"). _
PivotFields("Sales").Orientation = xlDataField
End With
xlObj.ActiveSheet.UsedRange.Select
Documents.Add
With xlObj
For Each newCell In .Selection
With Selection
.InsertAfter Text:=newCell.Value
mCount = mCount + 1
If mCount Mod xlObj.Selection.Columns.Count = 0 Then
.InsertAfter Text:=vbCr
Else
.InsertAfter Text:=vbTab
End If
End With
Next newCell
ActiveDocument.Range.ConvertToTable _
Separator:=wdSeparateByTabs
ActiveDocument.Tables(1).AutoFormat _
Format:=wdTableFormatClassic1
End With
If theError = 429 Then
xlObj.DisplayAlerts = False
xlObj.Quit
End If
Set xlObj = Nothing
End Sub
179216 OFF98: How to Use the Microsoft Office Installer Program
Additional query words: ole pivot table
Keywords: kbhowto kbprogramming kbdtacode kbcode KB183798