Problem mit Diagramm SetSourceData

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Moe,
danke für Deine Bereitschaft da mal drüber zu schauen. Hoffe, Du schaust noch mal rein in diesen Thread.
Den Auszug habe ich bewußt gekürzt, um niemanden zu verschrecken. Fremder Code ist nunmal schwer zu erfassen.
Die Prozedur ist nur ein Teilschritt einer gesamten Dateierstellung.
Nun denn:

Sub ChartsErstellen()
Const mintcWidth As Long = 500
Const mintcHeight As Long = 200
Const mintcLeft As Long = 600
Const mintcAxisFontSize As Long = 8
Dim objChart As ChartObject                                                     'Verweis auf das DiagrammObjekt
Dim ax As Axis                                                                  'Diagrammachse
Dim tb As Shape                                                                 'Textbox für Quelle des Diagramms

Dim qdAuswertungen As DAO.QueryDef
Dim rsAuswertungen As DAO.Recordset                                             '
Dim qdSpalten As DAO.QueryDef
Dim rsSpalten As DAO.Recordset                                                  '
Dim rsSpaltenAW As DAO.Recordset
Dim dblTop As Double                                                            'Position Diagrammposition Ausrichtung OBEN
Dim dblLeft As Double                                                           'Position Diagrammposition Ausrichtung LINKS
Dim intGemeinden As Integer                                                     'Anzahl der Gemeinden in der Ausgabe
Dim strTMP As String
Stop
'**************************************Bereitstellung der Recordsets***********************************************************************
Set qdAuswertungen = CurrentDb.QueryDefs("xlDiagrammeListe")                    'Verweis auf das Query
qdAuswertungen.Parameters("Auswertung") = _
                             [Forms]![fmain_Auswertungsdatei]![cboAuswertung]   'Bereitstellung des Parameters
Set rsAuswertungen = qdAuswertungen.OpenRecordset                               'Abfrage als Liste der Diagramme

Set qdSpalten = CurrentDb.QueryDefs("xlDiagrammeSpalten")                       'Verweis auf das Query
qdSpalten.Parameters("Auswertung") = _
                             [Forms]![fmain_Auswertungsdatei]![cboAuswertung]   'Bereitstellung des Parameters
Set rsSpalten = qdSpalten.OpenRecordset                                         'Abfrage mit Datenquellinformationen für die Diagramme
Set xlSh = xlWb.Worksheets.Add(xlWb.Worksheets(1))                              'Blatt für Diagramme erzeugen
xlSh.Name = "Diagramme"                                                         'Blatt benennen
Set xlSh = xlWb.Worksheets("00_Globale Daten")
'**************************************Chart erstellen*************************************************************************************
intGemeinden = DCount("*", "tkey_Gemeinde", _
                      "fiPrüfung = " & GetOptionswert("Prüfung") & " And GemeindeAuswertung = -1")               'GemeindeAnzahl für die Ermittlung der Excel DatenQuelle
With rsAuswertungen                                                             'Durchlaufe die Diagramme

    dblTop = xlSh.Cells(.AbsolutePosition + 2, .AbsolutePosition + 2).Top       'Ermittle Position OBEN
    dblLeft = xlSh.Cells(.AbsolutePosition + 2, .AbsolutePosition + 2).Left     'Ermittle Position LINKS


    '**********************************Loop durch Auswertungen*****************************************************************************
    Do Until .EOF
        If DCount("*", "trel_DiagrammSpalten", "fiDiagramm = " & .Fields("DiagrammID") & " AND dsZeigen = -1") <> 0 Then
        Set objChart = xlSh.ChartObjects.Add(dblLeft, dblTop, _
                                             mintcWidth, mintcHeight)           'neues Diagramm erstellen mit angegebenen Dimensionen
        objChart.Chart.ChartArea.AutoScaleFont = False                          'Deaktiviert eigenständiges anpassen der Fonts
        'objChart.Chart.Name = .Fields("DiagrammTitel")                         'Für späteren Verweis Namen vergeben
        objChart.Chart.ChartType = .Fields("xlDiagrammTypID")                   'Diagrammtyp zuweisen aus der Benutzerzeinstellung

        rsSpalten.Filter = "Diagramm = " & .Fields("DiagrammID")                'Nur Zeilen das aktuelle Diagramm
        Set rsSpaltenAW = rsSpalten.OpenRecordset


        '******************************Loop durch Spalten**********************************************************************************
        strTMP = GetChartDataSourceString(.Fields("Zeile"), 1, _
                                                intGemeinden)
        Do Until rsSpaltenAW.EOF
            If rsSpaltenAW.Fields("dsZeigen") = "Wahr" Then
                strTMP = strTMP & "," & GetChartDataSourceString(.Fields("Zeile"), _
                                                     rsSpaltenAW.Fields("Spalte"), _
                                                     intGemeinden)
            End If
            rsSpaltenAW.MoveNext
        Loop
        rsSpaltenAW.Close


        '******************************Charteigenschaften zuweisen*************************************************************************
        objChart.Chart.SetSourceData Source:=xlWb.Sheets("00_Globale Daten").Range(strTMP), PlotBy:=xlColumns
        'objChart.Chart.SetSourceData Source:=xlWb.Worksheets(CStr(.Fields("Blatt"))).Range(strTMP), PlotBy:=xlColumns
        objChart.Chart.HasTitle = True
        objChart.Chart.ChartTitle.Characters.Text = .Fields("DiagrammTitel")


        '******************************Textbox für ChartQuelle*****************************************************************************
        Set tb = objChart.Chart.Shapes.AddTextbox(6, 10, _
                                            objChart.Height - 15, _
                                            objChart.Width / 2, 10)     'Orientation 6 = msoTextOrientationHorizontalRotatedFarEast
        tb.Left = objChart.Width - tb.Width - 20
        tb.TextFrame.Characters.Font.Size = 7
        tb.TextFrame.Characters.Text = Format(Now(), "dd/mm/yyyy hh:mm")
        If .Fields("DiagrammQuelle") <> "" Then
            tb.TextFrame.Characters.Text = tb.TextFrame.Characters.Text & _
                                "; Quelle: " & .Fields("DiagrammQuelle")
        End If
        tb.TextFrame.HorizontalAlignment = xlHAlignRight

        Set tb = objChart.Chart.Shapes.AddTextbox(6, 3, _
                                            objChart.Height - 15, _
                                            objChart.Width / 2, 10)     'Orientation 6 = msoTextOrientationHorizontalRotatedFarEast
        tb.TextFrame.Characters.Font.Size = 7
        tb.TextFrame.Characters.Text = "awid=" & .Fields("AuswertungsID") & "; " & _
                                       "did=" & .Fields("DiagrammID")

        '******************************Achsen**********************************************************************************************
        Set ax = objChart.Chart.Axes(xlCategory, xlPrimary)
        ax.TickLabels.Font.Size = mintcAxisFontSize

        Set ax = objChart.Chart.Axes(xlValue, xlPrimary)
        ax.TickLabels.NumberFormat = .Fields("xlZahlenFormat")
        ax.TickLabels.Font.Size = mintcAxisFontSize


        '******************************Legende*********************************************************************************************
        If .Fields("Legende") = -1 Then
            objChart.Chart.HasLegend = True
            objChart.Chart.Legend.Position = .Fields("xlLegendePos")
            objChart.Chart.Legend.Top = objChart.Chart.Legend.Top - 3
        Else
            objChart.Chart.HasLegend = False
        End If

        End If
        .MoveNext
    Loop
    rsSpalten.Close
    rsAuswertungen.Close
End With
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Function GetChartDataSourceString(lngZeile As Long, lngSpalte As Long, intOffset As Integer) As String

Dim tmp As String
    'Basisstring aus Blatt zzgl. erster Zelle
    tmp = Chr(64 + lngSpalte) & lngZeile

    If intOffset <> 0 Then
       tmp = tmp & ":" & Chr(64 + lngSpalte) & lngZeile + intOffset
    End If
GetChartDataSourceString = tmp
End Function

Code eingefügt mit Syntaxhighlighter 2.5

Beliebteste Forumthreads (12 Monate)

Problem mit Diagramm SetSourceData

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

13 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Problem mit Diagramm SetSourceData

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

13 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread