Thema Datum  Von Nutzer Rating
Antwort
29.01.2017 17:29:57 Knud
Solved
29.01.2017 19:58:43 Mackie
NotSolved
29.01.2017 20:27:39 Gast24575
NotSolved
29.01.2017 23:03:11 Mackie
NotSolved
05.02.2017 13:33:01 Gast31932
NotSolved
29.01.2017 20:48:58 Mackie
NotSolved
Rot Diagrammblätter nur löschen wenn keine Daten vorhanden sind
29.01.2017 21:27:20 Gast33073
NotSolved
29.01.2017 21:31:42 Mackie
NotSolved
29.01.2017 21:38:29 Gast27707
NotSolved
30.01.2017 22:55:44 Mackie
NotSolved

Ansicht des Beitrags:
Von:
Gast33073
Datum:
29.01.2017 21:27:20
Views:
762
Rating: Antwort:
  Ja
Thema:
Diagrammblätter nur löschen wenn keine Daten vorhanden sind

Ich glaube es geht  wenn ich die erste leere Zelle finde und dann auf löschen springe.

Sub Fahrkurve_MPAS()

' Fahrkurve_Makro

    Application.ScreenUpdating = False
    Sheets("Fahrkurve").Select
    
Set wb1 = ThisWorkbook
      
       'Bis zur letzten Zelle von Spalta A
        Zeile = Range("A65536").End(xlUp).Row
    Range(Cells(1, 1), Cells(Zeile, 5)).Select
    Selection.Copy
    
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.ScreenUpdating = False
        
    Range(Selection, Selection.End(xlDown)).Select

   ' Zeilen2 und 3 selektieren
   Rows("2:3").Select
    Application.CutCopyMode = False
    ' Zeilen löschen
    Selection.Delete Shift:=xlUp
    
    ' Selektiere A4 Zeit, B4 Sollgeschwindigkeit, C4 Istgeschwindigkeit
    Range("A4:C4").Select
    ' Selektiere automatisch bis zur letzten Zelle von Reihe C
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    
    ' Nehme die selektierten Daten bis zur letzten beschriebenen Zelle
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Shapes.AddChart.Select
    
    ' Erstelle ein Liniendiagramm
    ActiveChart.ChartType = xlXYScatterLinesNoMarkers
    

     ' Lege die Geschwindigkeiten auf die Horizontale, untere Werteachse
     ActiveChart.SetSourceData Source:=Range("Tabelle1!$A$4:$C$65536")
     
    
    ' Diagramm verschieben auf ein neues Blatt und Setz die Achsskalierung auf auto
    Application.CutCopyMode = False
    ActiveChart.Location Where:=xlLocationAsNewSheet
    ActiveChart.ChartArea.Select

    
    ' Entferne die Hauptgitternetzlinien
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    Selection.Delete
    
    ActiveChart.ChartArea.Select
    ActiveChart.SeriesCollection(1).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent3
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
    End With
    
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
    End With
    
    ' Setze Sollgeschwindigkeitsfarbe auf blau
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 1
    End With
    
    
    ActiveChart.Legend.Select
    ActiveChart.Legend.Select
    Selection.Position = xlBottom
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    
    
    ' Diagrammtitel
    Selection.Caption = Sheets("Tabelle1").Range("E1").Value

    
    ' Achstitel
    ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
    Selection.Caption = "Zeit [s]"
    ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
    Selection.Caption = "Geschwindigkeit [km/h]"
    ActiveChart.PlotArea.Select
    ActiveChart.SeriesCollection.NewSeries
    
    ' Entferne den Legendeneintrag Datenreihe3
    ActiveChart.Legend.LegendEntries(3).Select
    Selection.Delete
    
    ActiveChart.SeriesCollection(2).Name = "=""V-Ist"""
    ActiveChart.SeriesCollection(1).Name = "=""V-Soll"""
    ActiveChart.SeriesCollection(2).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 1
    End With
    ActiveChart.ChartArea.Select
    Sheets("Diagramm1").Select
    Sheets("Diagramm1").Name = "gesamt"
    ActiveChart.ChartArea.Select
    Sheets("gesamt").Select
    Sheets("gesamt").Copy Before:=Sheets(2)
    Sheets("gesamt (2)").Select
    Sheets("gesamt (2)").Name = "0-300s"
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlCategory).Select
    

    ActiveChart.Axes(xlCategory).MaximumScale = 300
    ActiveChart.Axes(xlValue).Select
    
    ActiveChart.ChartArea.Select
    Sheets("0-300s").Select
    Sheets("0-300s").Copy Before:=Sheets(3)
    Sheets("0-300s (2)").Select
    Sheets("0-300s (2)").Name = "300-600s"
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlCategory).Select
    
    
    ActiveChart.Axes(xlCategory).MinimumScale = 300
    ActiveChart.Axes(xlCategory).MaximumScale = 600
    
    ActiveChart.ChartArea.Select
    Sheets("300-600s").Select
    Sheets("300-600s").Copy Before:=Sheets(4)
    Sheets("300-600s (2)").Select
    Sheets("300-600s (2)").Name = "600-900s"
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlCategory).Select
    
    ActiveChart.Axes(xlCategory).MinimumScale = 600
    ActiveChart.Axes(xlCategory).MaximumScale = 900
    
    ActiveChart.ChartArea.Select
    Sheets("600-900s").Select
    Sheets("600-900s").Copy Before:=Sheets(5)
    Sheets("600-900s (2)").Select
    Sheets("600-900s (2)").Name = "900-1200s"
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlCategory).Select
    
    ActiveChart.Axes(xlCategory).MinimumScale = 900
    ActiveChart.Axes(xlCategory).MaximumScale = 1200
    
    ActiveChart.ChartArea.Select
    Sheets("900-1200s").Select
    Sheets("900-1200s").Copy Before:=Sheets(6)
    Sheets("900-1200s (2)").Select
    Sheets("900-1200s (2)").Name = "1200-1500s"
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlCategory).Select
    
    ActiveChart.Axes(xlCategory).MinimumScale = 1200
    ActiveChart.Axes(xlCategory).MaximumScale = 1500
    
    ActiveChart.ChartArea.Select
    Sheets("1200-1500s").Select
    Sheets("1200-1500s").Copy Before:=Sheets(7)
    Sheets("1200-1500s (2)").Select
    Sheets("1200-1500s (2)").Name = "1500-1800s"
    Sheets("1500-1800s").Select
    Sheets("1500-1800s").Name = "1500-1800s"
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlCategory).Select
    
    ActiveChart.Axes(xlCategory).MinimumScale = 1500
    ActiveChart.Axes(xlCategory).MaximumScale = 1800
    
    ActiveChart.Axes(xlValue).Select
 
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.NumberFormat = "0.00"
    ActiveChart.ChartArea.Select
    Sheets("1500-1800s").Select
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.NumberFormat = "0.00"
    ActiveChart.ChartArea.Select
    Sheets("1200-1500s").Select
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.NumberFormat = "0.00"
    ActiveChart.ChartArea.Select
    Sheets("900-1200s").Select
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.NumberFormat = "0.00"
    ActiveChart.ChartArea.Select
    Sheets("600-900s").Select
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.NumberFormat = "0.00"
    ActiveChart.ChartArea.Select
    Sheets("300-600s").Select
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.NumberFormat = "0.00"
    ActiveChart.ChartArea.Select
    Sheets("0-300s").Select
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.NumberFormat = "0.00"
    ActiveChart.ChartArea.Select
    Sheets("gesamt").Select
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    Selection.TickLabels.NumberFormat = "0.00"
    ActiveChart.ChartArea.Select
    Sheets("Tabelle1").Select
    Sheets("Tabelle1").Name = "Daten"
    
    ' Schalte um auf Gesamt
    Sheets("gesamt").Select
    
End Sub

 


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
29.01.2017 17:29:57 Knud
Solved
29.01.2017 19:58:43 Mackie
NotSolved
29.01.2017 20:27:39 Gast24575
NotSolved
29.01.2017 23:03:11 Mackie
NotSolved
05.02.2017 13:33:01 Gast31932
NotSolved
29.01.2017 20:48:58 Mackie
NotSolved
Rot Diagrammblätter nur löschen wenn keine Daten vorhanden sind
29.01.2017 21:27:20 Gast33073
NotSolved
29.01.2017 21:31:42 Mackie
NotSolved
29.01.2017 21:38:29 Gast27707
NotSolved
30.01.2017 22:55:44 Mackie
NotSolved