Hey Leute,
hab hier n ganz merkwürdigen Fehler.
Mal ganz von Vorne: Habe Charts angelegt auf dem Worksheet mit (Name) = Charts & Name = Charts. Gibt auch noch ein Worksheet mit (Name) = SheetHC & Name = HiddenCache. Da werden verschiedene Werte zwischengespeichert.
In der Sub GenerateCharts, den ich hier im Anschluss anfüge, wird zunächst immer jeweils eine Chart erstellt und anschließend als Bild in einen Ordner im Temp Verzeichnis gespeichert. Dieses Bild soll eigentlich den Namen cht.Name annehmen, wobei cht jeweils der aktuell bearbeiteten Chart zugewiesen ist. Da meine Charts auf dem Worksheet Charts angelegt sind würde das dann bei einer Chart mit dem Namen 'RevenueChart' eigentlich so aussehen: 'Charts RevenueChart.jpg'.
Aber leider nicht der Fall: zumindest nich wenn ich den Code mittels F5 in einem Durchlauf ausführen lasse. Aus irgendeinem Grund packt VBA mir den Namen des anderen Worksheets HiddenCache vor den Namen der Chart, also bspw: 'HiddenCache RevenueChart.jpg'. Wenn ich den Code allerdings Zeile für Zeile ausführe werden die Charts mit korrektem Namen abgespeichert.Ich habe sogar zum Debugging ein If statement eingebaut, dass da lautete:
If InStr(cht.Name, "HiddenChache") Then
MsgBox "somethings up"
End If
Dann hab ich mir einen Haltepunkt auf die MsgBox gelegt und den Code wieder mit F5 ausgeführt. Der Code kommt am gesetzten Haltepunkt zum Stehen. Aber wenn ich jetzt cht.Name mit Add Watch... beobachte, ist dessen Wert auf einmal wieder "Charts RevenueChart". Und wenn ich nochmal zur If-Kondition zurück gehe, springt der Debugger direkt zu End If weiter. Ich krepier..
Hier Sub GenerateCharts (aufgerufen wird der wiederum von Sub LoadPCO, hab ich auch noch dahinter angehängt):
Sub GenerateCharts()
Charts.Visible = xlSheetVisible
Charts.Activate
ActiveWindow.Zoom = 100
Dim x As Integer, y As Integer, i As Integer, ChartNum As Integer, chtObj As ChartObject, cht As Chart, ValueRange As String
Dim Divisor As Integer
For ChartNum = 1 To 3
x = 1
If ChartNum = 1 Then
Set chtObj = Charts.ChartObjects("RevenueChart")
Set cht = chtObj.Chart
cht.ChartType = xlLineMarkersStacked
ValueRange = "'!$B$2:$M$2"
ChtTitle = "REVENUE (ACC)"
cht.ChartArea.Height = 295
cht.ChartArea.Width = 486.5
cht.ChartArea.Top = 0
cht.ChartArea.Left = 0
ElseIf ChartNum = 2 Then
Set chtObj = Charts.ChartObjects("MarginChart")
Set cht = chtObj.Chart
cht.ChartType = xlLineMarkers
ValueRange = "'!$B$3:$M$3"
ChtTitle = "MARGIN"
cht.ChartArea.Height = 295
cht.ChartArea.Width = 486.5
cht.ChartArea.Top = 400
cht.ChartArea.Left = 0
ElseIf ChartNum = 3 Then
Set chtObj = Charts.ChartObjects("ADRChart")
Set cht = chtObj.Chart
cht.ChartType = xlLineMarkersStacked
ValueRange = "'!$B$4:$M$4"
ChtTitle = "AVERAGE DAILY RATE"
cht.ChartArea.Height = 295
cht.ChartArea.Width = 486.5
cht.ChartArea.Top = 800
cht.ChartArea.Left = 0
End If
cht.ChartArea.ClearContents
For i = Sheets.Count - CountColumnItems(2, 1) + 1 To Sheets.Count
'Compare Average Revenue over 12 month period to later set the order of the series in the stacked revenue graph
For y = 2 To 13
On Error Resume Next
Sum = Sum + Sheets(i).Cells(ChartNum + 1, y)
If Err.Number <> 0 Then
Err.Clear
Else
Divisor = Divisor + 1
End If
Next y
If Not Divisor = 0 Then
AVGValue = Sum / Divisor
Else
Exit For
End If
For y = x To 1 Step -1
If y = 1 Then
SheetHC.Cells(y, 6) = AVGValue
SheetHC.Cells(y, 5).Value = Sheets(i).Cells(1, 1).Value
Else
If SheetHC.Cells(y - 1, 6).Value > AVGValue Then
SheetHC.Cells(y, 6) = SheetHC.Cells(y - 1, 6)
SheetHC.Cells(y, 5) = SheetHC.Cells(y - 1, 5)
Else
SheetHC.Cells(y, 6) = AVGValue
SheetHC.Cells(y, 5).Value = Sheets(i).Cells(1, 1).Value
Exit For
End If
End If
Next y
Sum = 0
AVGValue = 0
Divisor = 0
'Fill the Graph with data
cht.SeriesCollection.NewSeries
cht.FullSeriesCollection(x).Name = "='" & Sheets(i).Name & "'!$A$1"
cht.FullSeriesCollection(x).Values = "='" & Sheets(i).Name & ValueRange
cht.FullSeriesCollection(x).XValues = "='" & Sheets(i).Name & "'!$B$1:$M$1"
x = x + 1
Next i
'Setting the order of series for the Revenue graph
If ChartNum = 2 Then
i = CountColumnItems(5, 1)
For x = 1 To CountColumnItems(5, 1)
cht.FullSeriesCollection(SheetHC.Cells(x, 5).Value).PlotOrder = i
i = i - 1
Next x
Else
For x = 1 To CountColumnItems(5, 1)
cht.FullSeriesCollection(SheetHC.Cells(x, 5).Value).PlotOrder = x
Next x
End If
'Formatting
cht.PlotArea.Height = 270
cht.PlotArea.Width = 380
cht.PlotArea.Top = 25
cht.PlotArea.Left = 0
cht.SetElement (msoElementChartTitleAboveChart)
cht.ChartTitle.Text = ChtTitle
With cht.ChartTitle.Format.TextFrame2.TextRange
.ParagraphFormat.TextDirection = msoTextDirectionLeftToRight
.ParagraphFormat.Alignment = msoAlignCenter
.Font.Name = "Bahnschrift SemiBold SemiConden"
.Font.Size = 18
End With
cht.SetElement (msoElementLegendRight)
With cht.Legend.Format.TextFrame2.TextRange.Font
.Name = "Bahnschrift Light Condensed"
.Size = 12
End With
cht.Legend.Top = cht.Axes(xlValue).Top
cht.Legend.Height = cht.Axes(xlValue).Height
With cht.Axes(xlValue).TickLabels.Font
.Name = "Bahnschrift Light SemiCondensed"
.Size = 12
End With
If ChartNum = 2 Then
cht.Axes(xlValue).TickLabels.NumberFormat = "0%"
Else
cht.Axes(xlValue).TickLabels.NumberFormat = "0"
End If
cht.Axes(xlValue).MajorGridlines.Format.line.Weight = 1
With cht.Axes(xlCategory).TickLabels.Font
.Name = "Bahnschrift Light SemiCondensed"
.Size = 12
End With
cht.Axes(xlCategory).TickLabelPosition = xlLow
cht.Axes(xlCategory).TickLabels.Orientation = 45
If ChartNum = 2 Then
For i = CountColumnItems(2, 1) To 1 Step -1
If Not i Mod 2 = 0 Then
With cht.FullSeriesCollection(i).Format
.line.ForeColor.RGB = RGB(23, 128, 169)
.Fill.ForeColor.RGB = RGB(23, 128, 169)
End With
Else
With cht.FullSeriesCollection(i).Format
.line.ForeColor.RGB = RGB(191, 191, 191)
.Fill.ForeColor.RGB = RGB(191, 191, 191)
End With
End If
With cht.FullSeriesCollection(i)
.Format.line.Weight = 2.5
.MarkerStyle = 8
.MarkerSize = 4
End With
Next i
Else
For i = 1 To CountColumnItems(2, 1)
If Not i Mod 2 = 0 Then
With cht.FullSeriesCollection(i).Format
.line.ForeColor.RGB = RGB(23, 128, 169)
.Fill.ForeColor.RGB = RGB(23, 128, 169)
End With
Else
With cht.FullSeriesCollection(i).Format
.line.ForeColor.RGB = RGB(191, 191, 191)
.Fill.ForeColor.RGB = RGB(191, 191, 191)
End With
End If
With cht.FullSeriesCollection(i)
.Format.line.Weight = 2.5
.MarkerStyle = 8
.MarkerSize = 4
End With
Next i
End If
SheetHC.Columns(5).ClearContents
SheetHC.Columns(6).ClearContents
cht.Export Environ("TEMP") & "\Project Controlling Overview\" & cht.Name & ".jpg", "JPEG"
' If Not ResizeImage(Environ("TEMP") & "\Project Controlling Overview\" & cht.Name & ".jpg", Environ("TEMP") & "\Project Controlling Overview\" & cht.Name & "Resized.jpg", True, 400, 655) Then
' MsgBox "Could not execute function ResizeImage() for " & cht.Name & "!"
' End If
Next ChartNum
Charts.Visible = xlSheetVeryHidden
End Sub
Hier Sub LoadPCO:
Sub LoadPCO()
GenerateCharts
LoadCharts True, True, True, True
Application.Visible = False
'remove after dev
Application.ScreenUpdating = False
For x = 1 To Worksheets.Count
If Not SheetTBL.Visible = xlSheetVisible Then
SheetTBL.Visible = xlSheetVisible
End If
If Not Sheets(x).Name = "Table" Then
Sheets(x).Visible = xlSheetVeryHidden
End If
Next x
Form_Personalized = FindWindowA(vbNullString, PCO.Caption)
ShowWindow Form_Personalized, SW_MAXIMIZE
End Sub
Bin über jeden Vorschlag dankbar, der Fehler macht mich verrückt!
|