Thema Datum  Von Nutzer Rating
Antwort
Rot Ganz merkwürdiger Fehler
10.05.2023 04:11:16 Ray
NotSolved
10.05.2023 04:25:47 Gast2234
NotSolved
10.05.2023 09:10:13 Gast78610
NotSolved
10.05.2023 09:26:38 Der
NotSolved
10.05.2023 09:34:33 ralf_b
NotSolved
10.05.2023 10:01:35 Gast2234
NotSolved

Ansicht des Beitrags:
Von:
Ray
Datum:
10.05.2023 04:11:16
Views:
1223
Rating: Antwort:
  Ja
Thema:
Ganz merkwürdiger Fehler

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!


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Ganz merkwürdiger Fehler
10.05.2023 04:11:16 Ray
NotSolved
10.05.2023 04:25:47 Gast2234
NotSolved
10.05.2023 09:10:13 Gast78610
NotSolved
10.05.2023 09:26:38 Der
NotSolved
10.05.2023 09:34:33 ralf_b
NotSolved
10.05.2023 10:01:35 Gast2234
NotSolved