AW: Select Anweisung kürzen
06.08.2009 16:06:42
Dagmar
Als dann gebe ich wohl besser mal eine gekürzte Verions des Programmes, da ich sonst nicht weiß, welche Infos noch benötigt werden (bitte nur antworten, wenn Ihr eine Lösung wisst, dass Ihr keine Lösung wisst, möchte ich das nicht wissen, da wir das nicht weiterhilft :-)
Besagte Zeilen, die ich kürzen möchte befinden sich vor dem Ende des ersten Programmes bevor _
der Unter-
Sub beginnt.
Public Const festeBlätter As Integer = 15
Public merken As String
Sub Dreiecke()
Dim BerArr As Variant
Dim z As Integer
'----------------------------------------------------------------------------------------------- _
Application.Calculation = xlManual
Application.ScreenUpdating = False
'----------------------------------------------------------------------------------------------- _
z = 3
While Range("Steuerung").Cells(z, 1).Value ""
Sheets.Add(After:=Sheets(Sheets.Count)).name = Range("Steuerung").Cells(z, 1)
Sheets("Vorlage").Cells.Copy
ActiveSheet.Paste
ActiveSheet.Cells(1, 1) = Range("Steuerung").Cells(z, 1)
'--------------------------------------------------------------------------------------- _
'Diagramm auf neue Daten anpassen
merken = ActiveSheet.name
ActiveSheet.name = "Blatt"
ActiveSheet.ChartObjects(1).Activate
ActiveChart.SeriesCollection(1).XValues = "=Blatt!R44C1:R57C1"
ActiveChart.SeriesCollection(1).Values = "=Blatt!R44C2:R57C2"
ActiveSheet.ChartObjects(2).Activate
ActiveChart.SeriesCollection(1).XValues = "=Blatt!R44C1:R57C1"
ActiveChart.SeriesCollection(1).Values = "=Blatt!R44C57:R57C57"
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "0%"
ActiveSheet.name = merken
'--------------------------------------------------------------------------------------- _
ActiveSheet.Cells(4, 1).Select
z = z + 1
Wend
'----------------------------------------------------------------------------------------------- _
z = 3
While Range("Steuerung").Cells(z, 1) ""
If Range("Steuerung").Cells(z, 3) = "Longtail1994" Then
Longtail1994 (Range("Steuerung").Cells(z, 1).Value)
ElseIf Range("Steuerung").Cells(z, 3) = "Longtail1998" Then
Longtail1998 (Range("Steuerung").Cells(z, 1).Value)
End If
z = z + 1
Wend
'----------------------------------------------------------------------------------------------- _
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.Calculation = xlManual
Application.ScreenUpdating = False
'----------------------------------------------------------------------------------------------- _
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Sheets("V 1994").Select
ActiveSheet.Cells(4, 1).Select
Sheets("V 1998").Select
ActiveSheet.Cells(4, 1).Select
Sheets("Start").Select
End Sub
'##################################################################
Sub Longtail1994(Sheetname)
'Anweisungsteil
Sheets(Sheetname).Select
'----------------------------------------------------------------------------------------------- _
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
ActiveSheet.ChartObjects(1).Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete
'----------------------------------------------------------------------------------------------- _
Sheets("V 1994").Select
Cells.Select
Selection.Copy
Sheets(Sheetname).Select
Cells.Select
ActiveSheet.Paste
ActiveSheet.Cells(1, 1) = Sheetname
'----------------------------------------------------------------------------------------------- _
Range("E91:T106, E112:T127").Select
Selection.ClearContents
'----------------------------------------------------------------------------------------------- _
merken = ActiveSheet.name
ActiveSheet.name = "Blatt"
ActiveSheet.ChartObjects(1).Activate
ActiveChart.SeriesCollection(1).XValues = "=Blatt!R9C1:R57C1"
ActiveChart.SeriesCollection(1).Values = "=Blatt!R9C2:R57C2"
With ActiveChart.Axes(xlCategory)
.MinimumScale = 1960
.MaximumScale = 2010
End With
ActiveSheet.ChartObjects(2).Activate
ActiveChart.SeriesCollection(1).XValues = "=Blatt!R48C1:R57C1"
ActiveChart.SeriesCollection(1).Values = "=Blatt!R48C57:R57C57"
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "0%"
ActiveSheet.name = merken
'----------------------------------------------------------------------------------------------- _
ActiveSheet.Cells(4, 1).Select
End Sub