ich habe ein Makro geschrieben, wo ich auch den Befehl "Application.ScreenUpdating = False" nutze. Nun bis heute hat es alles wunderbar funktioniert, nun habe ich gerade noch was eingebaut und jetzt funktioniert es nicht mehr.
Hier ist dieser Makro: er ist ein bisschen lang geraten
Sub Makro_Diagramme_aktualisieren()
'
' Makro, Diagrammfarbe für *******Kostendiagramme******** aktualisieren
' Makro am 14.10.2002 von Decker erstellt
'
Dim MyTot As Long, g As Long, j As Integer
Dim DiagrammAnfang As Integer
Dim DiagrammEnde As Integer
Dim DiagrammString As String
Dim i As Integer
Dim iZelle As Integer
Dim zaehler1 As Integer, zaehler2 As Integer
DiagrammAnfang = 1 'Nummer des ersten Diagramms
DiagrammEnde = 27 + 1 'Nummer des letzten Diagramms + 1
i = DiagrammAnfang 'Initialisierung
iZelle = 5 'die erste Zelle(Zeile) in der der Differenzbetrag steht, hier z.B. 5 (F5)
zaehler1 = 5 'notwendig zur Berechnung von 75% (grüne Farbe im Diagramm)
zaehler2 = zaehler1 + 1
MyTot = 27 ' = Anzahl der Diagrammen
g = 0 'Zaehler für Statusleiste
'Abschalten (wie "Echo off")
Application.ScreenUpdating = False
Do While i <> (DiagrammEnde - 1)
g = g + 1
DiagrammString = "Diagramm " & i
StatBar g, MyTot, "Processing", True
wert1 = Worksheets("Diagramme").Range("B" & zaehler1).Value
wert2 = Worksheets("Diagramme").Range("B" & zaehler2).Value
wert1i = Worksheets("Diagramme").Range("I" & zaehler1).Value
wert2i = Worksheets("Diagramme").Range("I" & zaehler2).Value
If (i = 3 Or i = 7 Or i = 11 Or i = 15 Or i = 19 Or i = 23) Then
prozentwert = wert2i * (1 - 0.75) * 1000
Else
prozentwert = wert2 * (1 - 0.75) * 1000
End If
ActiveSheet.ChartObjects(DiagrammString).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
Selection.InvertIfNegative = False
ActiveWindow.Visible = False
Windows("Ergebnisblatt.xls").Activate
Sheets("Ergebnistabelle").Select
Range("F" & iZelle).Select
If (ActiveCell <= 0 And ActiveCell > -prozentwert) Then
Sheets("Diagramme").Select
ActiveSheet.ChartObjects(DiagrammString).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else
ActiveWindow.Visible = False
Windows("Ergebnisblatt.xls").Activate
Sheets("Ergebnistabelle").Select
Range("F" & iZelle).Select
If (ActiveCell > 0) Then
Sheets("Diagramme").Select
ActiveSheet.ChartObjects(DiagrammString).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Else
Sheets("Diagramme").Select
ActiveSheet.ChartObjects(DiagrammString).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
End If
End If
i = i + 2
If (i = 5 Or i = 9 Or i = 13 Or i = 17 Or i = 21) Then
zaehler1 = zaehler1 + 6
zaehler2 = zaehler1 + 1
End If
iZelle = iZelle + 1
Loop
'
' Makro, Diagrammfarbe für ********Termindiagramme******** aktualisieren
' Makro am 14.10.2002 von Decker erstellt
'
DiagrammAnfang = 2 'Nummer des ersten Diagramms
DiagrammEnde = 28 + 1 'Nummer des letzten Diagramms + 1
i = DiagrammAnfang
iZelle = 5
zaehler1 = 7
zaehler2 = zaehler1 + 1
Do While i <> (DiagrammEnde + 1)
DiagrammString = "Diagramm " & i
g = g + 1
StatBar g, MyTot, "Processing", True
wert1 = Worksheets("Diagramme").Range("B" & zaehler1).Value
wert2 = Worksheets("Diagramme").Range("B" & zaehler2).Value
wert1i = Worksheets("Diagramme").Range("I" & zaehler1).Value
wert2i = Worksheets("Diagramme").Range("I" & zaehler2).Value
If (i = 4 Or i = 8 Or i = 12 Or i = 16 Or i = 20 Or i = 24) Then
prozentwert = wert2i * (1 - 0.75) * 1000
Else
prozentwert = wert2 * (1 - 0.75) * 1000
End If
ActiveSheet.ChartObjects(DiagrammString).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = True
Selection.InvertIfNegative = False
ActiveWindow.Visible = False
Windows("Ergebnisblatt.xls").Activate
Sheets("Ergebnistabelle").Select
Range("G" & iZelle).Select
If (ActiveCell <= 0 And ActiveCell > -10) Then
Sheets("Diagramme").Select
ActiveSheet.ChartObjects(DiagrammString).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else
ActiveWindow.Visible = False
Windows("Ergebnisblatt.xls").Activate
Sheets("Ergebnistabelle").Select
Range("G" & iZelle).Select
If (ActiveCell > 0) Then
Sheets("Diagramme").Select
ActiveSheet.ChartObjects(DiagrammString).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Else
Sheets("Diagramme").Select
ActiveSheet.ChartObjects(DiagrammString).Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Interior
.ColorIndex = 8
.Pattern = xlSolid
End With
End If
End If
i = i + 2
If (i = 6 Or i = 10 Or i = 14 Or i = 18 Or i = 22) Then
zaehler1 = zaehler1 + 6
zaehler2 = zaehler1 + 1
End If
iZelle = iZelle + 1
Loop
ActiveWindow.Visible = False
Windows("Ergebnisblatt.xls").Activate
Sheets("Diagramme").Select
Range("A1").Select
Application.StatusBar = False
'Einschlaten (Echo)
Application.ScreenUpdating = True
End Sub
Sub ProgressBarStart()
Load ProgressDlg
ProgressDlg.Show
End Sub
Sub StatBar(MyIndex As Long, MyTotal As Long, MyText As String, InclPercent As Boolean)
Const NumBars As Integer = 60 ' # of characters in the bar
Const FillChar As String * 1 = "•" ' alt+0149 or try out your own character
Const DoneChar As String * 1 = "»" ' alt+0187 or try out your own character
Dim PctDone As Integer, FBar As Integer, BBar As Integer, BarText As String
If MyIndex Mod CInt((MyTotal * 0.02)) <> 0 Then Exit Sub
' previous line speeds up the macro by not updating the statusbar for every single record
If MyText <> Empty Then BarText = MyText & " " Else BarText = Empty
PctDone = CInt((MyIndex / MyTotal) * 100)
FBar = CInt(PctDone / 100 * NumBars)
BBar = NumBars - FBar
If InclPercent Then
BarText = BarText & " " & PctDone & " % "
End If
Application.StatusBar = BarText & Application.Rept(DoneChar, FBar) & Application.Rept(FillChar, BBar)
End Sub
Würde mich freuen, wenn ich Anregungen bekomme.
mfg
Steffen