title image


Smiley Re: Mir nicht ganz klar das Problem, aber..
Hi!



Sub Diagramm()

Dim Ws As Worksheet '<- Definitionen (Worksheet = Tabellenblatt, Range = Zellbereich,

Dim Rn, Srt As Range 'Long = Ganze Zahl von -2 Mio bis 2 Mio,

Dim Rw, i As Long ' String = Zeichenfolge (bis 255 Zeichen)

Dim Adr, Nm As String

Set Ws = Worksheets("Tabelle1") '<- Worksheet und Range sind Objekte, deshalb müssen sie

Set Srt = Ws.Range("B1") ' mit "Set" definiert werden



Do While Rw < 65536 ' Do While ist eine Schleife, Rw gibt hier den Zeile

If i = 0 Then Set Srt = Srt.End(xlDown) 'der aktuellen Zelle wieder

Set Rn = Srt.CurrentRegion 'Currentregion = letzte Zellen vor Leerzellen

Adr = Rn.Address(False, False) 'Address = Zellenadresse z.B. A1

Rw = Mid(Adr, 2, InStr(Adr, ":") - 2) * 1 ' Mid entspricht der Excelfunktion Teil() mit 1 multipliziert weil Mid einen String zurückgibt und Rw als Zahl definiert ist

Nm = Ws.Cells(Rw, 1) & "_" & Ws.Cells(Rw, 2) ' sind die jeweiligen Überschriften der Tabellen

Charts.Add ' hier wird ein neues Diagramm erstellt

With ActiveChart ' With legt Eigenschaften und Methoden fest

.ChartType = xl3DPie '<- wie soll das Diagramm aussehen

.SetSourceData Source:=Sheets(Ws.Name).Range(Adr), PlotBy:=xlColumns 'wo kommen die Daten her, das Diagramm geht nach Spalten

.Location Where:=xlLocationAsNewSheet ' wo wird das Diagramm erstellt (Neues Blatt)

.Name = Nm ' Die Bezeichnung des neuen Blattes

.Move after:=Ws ' Das Dia wird hinter das Quellblatt geschoben

.Move after:=Charts(Charts.Count) ' Das Dia wird hinter das letzte Dia geschoben

End With

i = i + 1 ' i ist ein Zähler der zur Definition von Srt dient

If i > 0 Then Set Srt = Srt.End(xlDown).End(xlDown)

Rw = Srt.Row ' Rw gibt wieder eine Zeilenzahl zurück

Loop

Set Ws = Nothing ' Um Prozeduren schneller zu machen leert man

Set Rn = Nothing ' Objektvariablen am Ende der Proz wieder

Set Srt = Nothing

End Sub

Code eingefügt mit: Excel Code Jeanie



Bei mir geht das einwandfrei.










Grüße

 

LXus

 

Win7 x64

Office 2013 x64



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: