Makro funktioniert nur im Einzelschrittmodus

06/05/2009 - 11:15 von Andre | Report spam
Hallihallo:

Hier mal wieder ein Problem, bei dem der Normalanwender nicht mehr
folgen kann. Mit dem folgenden Makro bestimme ich die Feldbeledung in
einer Pivottabelle. Lasse ich das Makro im Einzelschrittmodus laufen
klappt alles, beim "normalen" Durchlauf werden nicht alle Datenfelder
eingeblendet und Excel verhàlt sich hinterher auch komisch (die
Umrandung für die AktiveZelle reagiert nicht mehr und Excel làsst sich
hierdurch nicht mehr normal benutzen. Auch das Beenden klappt nicht
mehr richtig)



Public Sub Pivot_KArtStrukturAnlegen()
Dim colFelder As New Collection
Dim pt As PivotTable
Dim Element
Dim oldCalc
Dim t%

Set pt = Nothing
On Error Resume Next
Set pt = ActiveCell.PivotTable
On Error GoTo 0
If Nothing Is pt Then
MsgBox ("keine Tabelle aktiviert.")
Exit Sub
End If


' neue Felder definieren
colFelder.Add "'82010000"
colFelder.Add "'82011000"
colFelder.Add "'82110000"
colFelder.Add "'82510000"
colFelder.Add "'82560000"
colFelder.Add "'82660000"
colFelder.Add "'82610000"
colFelder.Add "'40189000"
colFelder.Add "'87040000"
colFelder.Add "'40180000"
colFelder.Add "'40180100"
colFelder.Add "'40180200"
colFelder.Add "'40180300"
colFelder.Add "'40180400"
colFelder.Add "'40180500"
colFelder.Add "'40185000"
colFelder.Add "'40186000"
colFelder.Add "'40186100"
colFelder.Add "'47997000"
colFelder.Add "'87050000"
colFelder.Add "Erlöse"
colFelder.Add "WKZ"
colFelder.Add "CAD"
colFelder.Add "A Aufwand"
colFelder.Add "A Erlös"
colFelder.Add "Gesamtergebnis"



On Error GoTo lblFallback

' Excel einstellen
Application.ScreenUpdating = True
pt.ManualUpdate = True
oldCalc = Application.Calculation
Application.Calculation = xlCalculationManual


' alle bisherigen Datenfelder entfernen
For t = 1 To pt.DataFields.Count
pt.DataFields.Item(1).Orientation = xlHidden
Next t

' neue Datenfelder einbringen
For Each Element In colFelder
Debug.Print Element
Call Anlege(pt, Element)
Next Element

lblFallback:
pt.ManualUpdate = False
Application.ScreenUpdating = True
Application.StatusBar = False
Application.Calculation = oldCalc
End Sub

Private Sub Anlege(ByRef pt As PivotTable, ByVal sName$)
Dim pf As PivotField

On Error GoTo lblErr
Application.StatusBar = sName
Set pf = pt.PivotFields(sName)
With pf
.Orientation = xlDataField
.Function = xlSum
.Caption = "S " & sName
.NumberFormat = "[blue]#,##0;[red]-#,##0"
.LabelRange.Activate
End With
Exit Sub
lblErr:
Debug.Print sName & Err.Number & Err.Description
On Error GoTo 0

End Sub



Vielleicht fàllt euch ja etwas dazu ein.


TIA, André
 

Lesen sie die antworten

#1 Melanie Breden
06/05/2009 - 22:09 | Warnen spam
Hallo Andre,

"Andre" schrieb:

Mit dem folgenden Makro bestimme ich die Feldbeledung in
einer Pivottabelle. Lasse ich das Makro im Einzelschrittmodus laufen
klappt alles, beim "normalen" Durchlauf werden nicht alle Datenfelder
eingeblendet und Excel verhàlt sich hinterher auch komisch (die
Umrandung für die AktiveZelle reagiert nicht mehr und Excel làsst sich
hierdurch nicht mehr normal benutzen. Auch das Beenden klappt nicht
mehr richtig)

If Nothing Is pt Then
MsgBox ("keine Tabelle aktiviert.")
Exit Sub
End If



mich wundert es, dass die Prüfung von pt mit dieser Syntax überhaupt làuft.
Normalerweise lautet die Syntax wie folgt:

If pt Is Nothing Then

Làuft die Prozedur jetzt besser?


Mit freundlichen Grüssen
Melanie Breden

- Microsoft MVP für Excel -
www.melanie-breden.de

Ribbon-Programmierung für Office 2007 http://tinyurl.com/59awla

Ähnliche fragen