AW: VBA-Code ändern in Makro zu Pivottabelle
20.05.2008 11:26:02
Wolfango
habe mal den kompletten Code (s.u.) untenstehend einkopiert....vermutlich habe ich einen Fehler beim Einstzen des Vorschlages von "fcs"(Franz) gemacht (ich habe die geänderten/hinzugefügten Teile unten fett markiert)....ich hab schon alles mögliche ausprobiert, ich bekomme es einfach nicht hin...
Wer weiß Rat?
Danke!
Gruß,
Wo.
Code:
Sub Auswertung_Teil_02()
Dim objPI As PivotItem
Range("A2").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Einfügetabelle2!R1C1:R1000C5").CreatePivotTable TableDestination:="", _
TableName:="PivotTable4", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable4")
.DisplayErrorString = True
.EnableDrilldown = False
.ErrorString = " "
End With
ActiveSheet.PivotTables("PivotTable4").PivotCache.RefreshOnFileOpen = True
ActiveSheet.PivotTables("PivotTable4").AddFields RowFields:=Array("Product", _
"Daten"), ColumnFields:="Country"
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Quantity")
.Orientation = xlDataField
.Caption = " Quantity"
.Position = 1
.
Function = xlSum
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Value II")
.Orientation = xlDataField
.Caption = " Value II"
.
Function = xlSum
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Product")
.PivotItems("").Visible = False
.PivotItems("").Visible = False
For Each objPI In .PivotItems
If Left(objPI.Name, 4) = "RECY" Then
.objPI.Visible = False
End If
Next
End With
Columns("A:A").EntireColumn.AutoFit
Range("C5").Select
ActiveSheet.PivotTables("PivotTable4").CalculatedFields.Add "Preis", _
"='Value II'/Quantity *1000", True
ActiveSheet.PivotTables("PivotTable4").PivotFields("Preis").Orientation = _
xlDataField
ActiveSheet.PivotTables("PivotTable4").PivotFields("Summe von Preis").Caption _
= " Preis"
ActiveWorkbook.ShowPivotTableFieldList = False
Range("C4:I4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:J").Select
Columns("A:J").EntireColumn.AutoFit
Range("A2").Select
ActiveCell.FormulaR1C1 = "Lieferung Testliner"
Range("A2:J2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Range("F7").Select
ActiveSheet.PivotTables("PivotTable4").PivotSelect "", xlDataAndLabel, True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A2:J2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
ActiveWindow.DisplayGridlines = False
Range("C5").Select
End Sub