VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

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

Ansicht des Beitrags:

Von:
Gast33073

Datum:
29.01.2017 21:27:20

Views:
964

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.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

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:
WYSIWYG-Editor, ctl00_Content_editor1 Editor WerkzeugleistenDokument Quellcode VorschauZwischenablage/Rückgängig AusschneidenTastaturkürzel Strg+X KopierenTastaturkürzel Strg+C EinfügenTastaturkürzel Strg+V Als Klartext einfügenTastaturkürzel Strg+Alt+Umschalt+V Aus Word einfügen RückgängigTastaturkürzel Strg+Z WiederherstellenTastaturkürzel Strg+YEditieren Suchen Ersetzen Alles auswählenGrundstile FettTastaturkürzel Strg+B KursivTastaturkürzel Strg+I UnterstrichenTastaturkürzel Strg+U Durchgestrichen Formatierung entfernenAbsatz Nummerierte Liste einfügen/entfernen Liste Einzug verringern Einzug erhöhen Zitatblock Linksbündig Zentriert Rechtsbündig BlocksatzLinks Link einfügen/editierenTastaturkürzel Strg+K Link entfernen AnkerEinfügen Bild Tabelle Horizontale Linie einfügen Smiley Sonderzeichen einfügen Einen Quelltextabschnitt einfügen oder aktualisierenStileFormatFormatSchriftartSchriftartGrößeGrößeFarben Textfarbe HintergrundfarbeWerkzeuge Maximieren Blöcke anzeigenabout Über CKEditor 4 Drücken Sie ALT 0 für Hilfe

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