Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
29.01.2017 17:29:57 |
Knud |
|
|
|
29.01.2017 19:58:43 |
Mackie |
|
|
|
29.01.2017 20:27:39 |
Gast24575 |
|
|
|
29.01.2017 23:03:11 |
Mackie |
|
|
|
05.02.2017 13:33:01 |
Gast31932 |
|
|
|
29.01.2017 20:48:58 |
Mackie |
|
|
Diagrammblätter nur löschen wenn keine Daten vorhanden sind |
29.01.2017 21:27:20 |
Gast33073 |
|
|
|
29.01.2017 21:31:42 |
Mackie |
|
|
|
29.01.2017 21:38:29 |
Gast27707 |
|
|
|
30.01.2017 22:55:44 |
Mackie |
|
|
Von:
Gast33073 |
Datum:
29.01.2017 21:27:20 |
Views:
768 |
Rating:
|
Antwort:
|
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
|
- 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
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- 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 |
|
|
|
29.01.2017 19:58:43 |
Mackie |
|
|
|
29.01.2017 20:27:39 |
Gast24575 |
|
|
|
29.01.2017 23:03:11 |
Mackie |
|
|
|
05.02.2017 13:33:01 |
Gast31932 |
|
|
|
29.01.2017 20:48:58 |
Mackie |
|
|
Diagrammblätter nur löschen wenn keine Daten vorhanden sind |
29.01.2017 21:27:20 |
Gast33073 |
|
|
|
29.01.2017 21:31:42 |
Mackie |
|
|
|
29.01.2017 21:38:29 |
Gast27707 |
|
|
|
30.01.2017 22:55:44 |
Mackie |
|
|