Diagramm verschieben

Bild

Betrifft: Diagramm verschieben
von: golem
Geschrieben am: 10.11.2003 09:32:47

Hallo und guten morgen,
mit folgendem Code wird ein Diagramm erzeugt und soll verschoben werden.
Es klappt alles bis auf das nachträgliche Verschieben des Diagramms.
Der Fehler kommt erst weiter unten.


Sub AddGraphToEachWorksheet()
Dim MyChart As Chart, Ws As Worksheet
For i = 0 To 97
    For Each Ws In Application.ActiveWorkbook.Worksheets
 
    If Ws.CodeName = "Tabelle" & i Then
    Set MyChart = Charts.Add
    
    With MyChart
                        Charts.Add
                        ActiveChart.ChartType = xlColumnClustered
                        ActiveChart.SetSourceData Source:=Ws.Range("A26,A28:A40,C26,C28:C40,E26,E28:E40"), PlotBy:=xlColumns
                        
                   ActiveChart.Location Where:=xlLocationAsObject,Name:=Ws.Name
                        
                      
                        With ActiveChart
                        .HasTitle = True
                        .ChartTitle.Characters.Text = "Sales"
                        .Axes(xlCategory, xlPrimary).HasTitle = False
                        .Axes(xlValue, xlPrimary).HasTitle = False
                        End With
                        ActiveChart.HasLegend = True
                        ActiveChart.Legend.Select
                        Selection.Position = xlTop
                        ActiveChart.HasDataTable = False
                        ActiveChart.SeriesCollection(2).Select
                        With Selection.Border
                        .ColorIndex = 6
                        .Weight = xlMedium
                        .LineStyle = xlContinuous
                        End With
                        Selection.Shadow = False
                        Selection.InvertIfNegative = False
                        Selection.Interior.ColorIndex = xlAutomatic
                        ActiveChart.SeriesCollection(2).ChartType = xlLine
                        ActiveChart.SeriesCollection(2).Select
                        With Selection.Border
                        .ColorIndex = 6
                        .Weight = xlThick
                        .LineStyle = xlContinuous
                        End With
                        With Selection
                        .MarkerBackgroundColorIndex = xlNone
                        .MarkerForegroundColorIndex = xlNone
                        .MarkerStyle = xlNone
                        .Smooth = False
                        .MarkerSize = 7
                        .Shadow = False
                        End With
                       
                        With ActiveChart.ChartGroups(1)     'Balkendicke
                            .Overlap = 0
                            .GapWidth = 500
                            .HasSeriesLines = False
                            .VaryByCategories = False
                        End With
                        
'###### ab hier wollte ich die Position ändern (erfolglos)##                   
    With MyChart 'es sollen alle Diagramme(auf allen Tabellen)verschoben werden
        .Left = 150
        .Top = 250
        .Height = 300
        .Width = 400
    End With
'#######################################################
    End With
    End If
    Next
Next
End Sub

__________________________________________________________________________
__________________________________________________________________________
Von Dan habe ich diesen Code bekommen, ich weiß nur nicht wie das für alle Tabellenblätter umgebastelt wird bzw wo ich den obigen Code einbauen kann...


Sub GraphAddAndPositionAndern()
    Dim Wsh As Worksheet ' in diesen Sheet wird der Graph zugegeben
    Dim ChrtObjts As ChartObjects ' Verweiss auf die ChartObjects Colllection
    Dim ChrtObj As ChartObject ' Obj. Var., die auf den neuen Graph verweisen wird
    
    ' die Verweiss/Object Vars. anstellen
    Set Wsh = ActiveSheet
    Set ChrtObjts = Wsh.ChartObjects
    
    Set ChrtObj = ChrtObjts.Add(0, 0, 100, 100) ' neuer Chart Object ist zugegeben worden
    
    ' die Position und Masse des Chart Objects anstellen
    With ChrtObj
        .Left = 150
        .Top = 250
        .Height = 300
        .Width = 400
    End With
    
    ' die andern Dinge durch ändern, mit Hilfe der Chart Eigenschafft
    With ChrtObj.Chart
        
    End With
    
End Sub

________________________________________________________________________

ich hoffe mein Problem einigermaßen verständlich gemacht zu haben(?).
Bild


Betrifft: AW: Diagramm verschieben
von: Dan
Geschrieben am: 10.11.2003 10:07:18

Halo,
zufalliger Weisse bin ich jetzt auch dabei :-)Wie ich sehe hast noch kleine Probs with Charts verschiebung. Gib mir bischen Zeit, ich schaue mir dein Code mal an und schicke dir die Losung :-). Mfg Dan.


Bild


Betrifft: AW: Diagramm verschieben
von: golem
Geschrieben am: 10.11.2003 10:19:28

Hi Dan,
Schön das ich Dich mit dieser Mail erreicht habe.
Die Formulierung kleine Probs ist stark beschönigt... :|


Bild


Betrifft: AW: Diagramm verschieben
von: Dan
Geschrieben am: 10.11.2003 10:44:15

Dein Code war fast OK, es waren nur noch ein paar Veranderungen notig. Es hat bei mir so gut funktioniert, versuch es noch bei dir. Hoffentlich klappt es jetzt ;-). D.

Option Explicit


Sub AddGraphToEachWorksheet()
    Dim ChrtObjts As ChartObjects, ChrtObj As ChartObject
    Dim MyChart As Chart, Ws As Worksheet
    Dim i%
    
    For i = 1 To 97
        ' for Each Ws In Application.ActiveWorkbook.Worksheets -- nicht notig
        
        Set Ws = Worksheets(i)
        
        If Ws.CodeName = "Tabelle" & i Then ' fur die Sheets mit CodeName Tabelle1 bis Tabelle97
            
            ' Set MyChart = Charts.Add -- nicht notig
            Set ChrtObjts = Ws.ChartObjects
            Set ChrtObj = ChrtObjts.Add(0, 0, 100, 100)
            Set MyChart = ChrtObj.Chart
            
            With MyChart
                ' Charts.Add -- nicht notig
                
                .ChartType = xlColumnClustered
                .SetSourceData Source:=Ws.Range("A26,A28:A40,C26,C28:C40,E26,E28:E40"), PlotBy:=xlColumns
                .Location Where:=xlLocationAsObject, Name:=Ws.Name
                
                .HasTitle = True
                .ChartTitle.Characters.Text = "Sales"
                .Axes(xlCategory, xlPrimary).HasTitle = False
                .Axes(xlValue, xlPrimary).HasTitle = False
                
                .HasLegend = True
                .Legend.Select
                Selection.Position = xlTop
                .HasDataTable = False
                .SeriesCollection(2).Select
                
                With Selection.Border
                    .ColorIndex = 6
                    .Weight = xlMedium
                    .LineStyle = xlContinuous
                End With
                
                Selection.Shadow = False
                Selection.InvertIfNegative = False
                Selection.Interior.ColorIndex = xlAutomatic
                .SeriesCollection(2).ChartType = xlLine
                .SeriesCollection(2).Select
                
                With Selection.Border
                    .ColorIndex = 6
                    .Weight = xlThick
                    .LineStyle = xlContinuous
                End With
                
                With Selection
                    .MarkerBackgroundColorIndex = xlNone
                    .MarkerForegroundColorIndex = xlNone
                    .MarkerStyle = xlNone
                    .Smooth = False
                    .MarkerSize = 7
                    .Shadow = False
                End With
                
                With .ChartGroups(1)     'Balkendicke
                    .Overlap = 0
                    .GapWidth = 500
                    .HasSeriesLines = False
                    .VaryByCategories = False
                End With
                                
                ' geht nicht, Object Type Chart hat keine solche Eigenschafften
                '###### ab hier wollte ich die Position ändern (erfolglos)##
    '            With MyChart 'es sollen alle Diagramme(auf allen Tabellen)verschoben werden
    '                .Left = 150
    '                .Top = 250
    '                .Height = 300
    '                .Width = 400
    '            End With
                '#######################################################
                
                With ChrtObj
                    .Left = 10
                    .Top = 15
                    .Height = 300
                    .Width = 450
                End With
                
            End With
        End If
        ' Next -- nicht notig
    Next i%
End Sub



Bild


Betrifft: AW: Diagramm verschieben
von: golem
Geschrieben am: 10.11.2003 10:54:45

Hallo Dan,
habe Code getestet und leider festgestellt das sich da gar nix tut (?).Das Makro macht nichts(keine Tabellenblätter werden durchlaufen etc).
Kann es sein, dass die 2.For schleife doch drin bleiben muss?
Werde noch eine Weile dran basteln und Dir dann Bericht erstatten.

Viele Grüsse
goli


Bild


Betrifft: AW: Diagramm verschieben
von: Dan
Geschrieben am: 10.11.2003 11:02:13

Ja, entschuldige bitte, ich habe es falsch verstanden. Die zweite Schleife muss bleiben. Also der Code sollte so aussehen:



Option Explicit


Sub AddGraphToEachWorksheet()
    Dim ChrtObjts As ChartObjects, ChrtObj As ChartObject
    Dim MyChart As Chart, Ws As Worksheet
    Dim i%
    
    For i = 1 To 97
        For Each Ws In Application.ActiveWorkbook.Worksheets
        
            If Ws.CodeName = "Tabelle" & i Then
                
                ' Set MyChart = Charts.Add -- nicht notig
                Set ChrtObjts = Ws.ChartObjects
                Set ChrtObj = ChrtObjts.Add(0, 0, 100, 100)
                Set MyChart = ChrtObj.Chart
                
                With MyChart
                    ' Charts.Add -- nicht notig
                    
                    .ChartType = xlColumnClustered
                    .SetSourceData Source:=Ws.Range("A26,A28:A40,C26,C28:C40,E26,E28:E40"), PlotBy:=xlColumns
                    .Location Where:=xlLocationAsObject, Name:=Ws.Name
                    
                    .HasTitle = True
                    .ChartTitle.Characters.Text = "Sales"
                    .Axes(xlCategory, xlPrimary).HasTitle = False
                    .Axes(xlValue, xlPrimary).HasTitle = False
                    
                    .HasLegend = True
                    .Legend.Select
                    Selection.Position = xlTop
                    .HasDataTable = False
                    .SeriesCollection(2).Select
                    
                    With Selection.Border
                        .ColorIndex = 6
                        .Weight = xlMedium
                        .LineStyle = xlContinuous
                    End With
                    
                    Selection.Shadow = False
                    Selection.InvertIfNegative = False
                    Selection.Interior.ColorIndex = xlAutomatic
                    .SeriesCollection(2).ChartType = xlLine
                    .SeriesCollection(2).Select
                    
                    With Selection.Border
                        .ColorIndex = 6
                        .Weight = xlThick
                        .LineStyle = xlContinuous
                    End With
                    
                    With Selection
                        .MarkerBackgroundColorIndex = xlNone
                        .MarkerForegroundColorIndex = xlNone
                        .MarkerStyle = xlNone
                        .Smooth = False
                        .MarkerSize = 7
                        .Shadow = False
                    End With
                    
                    With .ChartGroups(1)     'Balkendicke
                        .Overlap = 0
                        .GapWidth = 500
                        .HasSeriesLines = False
                        .VaryByCategories = False
                    End With
                                    
                    ' geht nicht, Object Type Chart hat keine solche Eigenschafften
                    '###### ab hier wollte ich die Position ändern (erfolglos)##
        '            With MyChart 'es sollen alle Diagramme(auf allen Tabellen)verschoben werden
        '                .Left = 150
        '                .Top = 250
        '                .Height = 300
        '                .Width = 400
        '            End With
                    '#######################################################
                    
                    With ChrtObj
                        .Left = 10
                        .Top = 15
                        .Height = 300
                        .Width = 450
                    End With
                    
                End With
            End If
        Next Ws
    Next i%
End Sub



Bild


Betrifft: AW: Diagramm verschieben
von: golem
Geschrieben am: 10.11.2003 11:20:33

DANKE DANKE DANKE DANKE DANKE DANKE DANKE

Dan, ich habe es soeben auch hingekriegt.
Ohne Deine Hilfe wäre das unmögliche nicht möglich gewesen! Danke

Noch eine letzte Frage-> Für was steht das(insbesondere die 2.Zeile):
Set ChrtObjts = Ws.ChartObjects
Set ChrtObj = ChrtObjts.Add(0, 0, 100, 100)'Was bedeuten die Werte/Zahlen?
Set MyChart = ChrtObj.Chart

Viele Grüsse
Goli


Bild


Betrifft: AAAHHHHHHHHH!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
von: golem
Geschrieben am: 10.11.2003 13:55:19

Sorry, es gibt doch noch Probleme.
Habe das Makro in eine andere Arbeitsmappe gestellt und ausgeführt.Ergebnis: alle SChriftarten sind falsch (bzw viel zu groß)....?
Wie kann ich ähnlich wie oben alle Objekte bzw Diagramme aller Tabellen löschen und/oder die Schriftart korrigieren?
Das Einfügen des Marorec-Codes gibt Probleme...


Bild


Betrifft: AW: AAAHHHHHHHHH!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
von: Dan
Geschrieben am: 10.11.2003 16:40:31

Hallo Golem,
ich bin wieder hier und werde jetzt versuchen das Problem mit den Charts bischen ausfuhlicher zu erklaren ;-)
Warte auf Code ;-) es kann jeder Augenblik kommen :-) D.


Bild


Betrifft: AW: Diagramm verschieben
von: golem
Geschrieben am: 10.11.2003 11:07:24

Habe das Prob erkannt:
er geht nie in die Forschleife(1.) rein weil da was mit dem Codenamen nicht stimmt...
mit der 2.Schleife funkt es bis jetzt uach noch nicht.
Werde weiter testen...


Bild


Betrifft: AW: Diagramm verschieben
von: golem
Geschrieben am: 10.11.2003 10:47:24

Hallo nochmal,
habe da etwas probiert...man könnte 2 MAkros durchlaufen lassen:
allerdings "spinnt" das MAkro noch so ein bißchen...


Sub TABELLENVERSCHIEBER()
Dim MyChart As Chart, Ws As Worksheet
For i = 0 To 97
    For Each Ws In Application.ActiveWorkbook.Worksheets
 
        If Ws.CodeName = "Tabelle" & i Then
          
    ActiveSheet.ChartObjects("Diagramm 1").Activate
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Diagramm 1").ScaleWidth 2.71, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Diagramm 1").ScaleHeight 1.21, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Diagramm 1").IncrementLeft 1566.75
    ActiveSheet.Shapes("Diagramm 1").IncrementTop 22.5
    Windows("test2.xls").SmallScroll Down:=9
    ActiveSheet.Shapes("Diagramm 1").ScaleWidth 1.01, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Diagramm 1").ScaleHeight 1.19, msoFalse, _
        msoScaleFromTopLeft
    ActiveChart.SeriesCollection(1).Select
    With ActiveChart.ChartGroups(1)
        .Overlap = 0
        .GapWidth = 500
        .HasSeriesLines = False
        .VaryByCategories = False
    End With
  '  ActiveWindow.Visible = False
   ' Windows("test2.xls").Activate
    Range("AL48").Select
        End If
    Next
Next
End Sub



Bild

Beiträge aus den Excel-Beispielen zum Thema " Diagramm verschieben "