Prozeduraufruf - einzeln ok - gemeinsam nicht
Gerd
ich habe ein Problem, über das ich mir schon eine Weile den Kopf zerbreche und keine Lösung finde.
Ich habe drei Prozeduren geschrieben A,B,C die nacheinander ausgeführt werden sollen. Wenn ich
manuell A ausführe, dann B, dann C geht alles ohne Probleme. Sobald ich sie gemeinsam aufrufe
Sub alle
A
B
C
Sub
gibt es einen Fehler und ich kann nicht mal debuggen, nur beenden. Mache ich grundsätzlich was
falsch in der Art der Programmierung ?
Anbei der Code, freue mich über jede Idee....
Viele Grüße,
GTFuchs
Sub style_neues_blatt() 'WARUM FUNKTIONIERE ICH NICHT ?
style_kopiere_LayoutMaster
style_benenne_labels
style_setze_Styleguide_um
End Sub
Sub style_kopiere_LayoutMaster()
Dim temp As String
temp = ActiveSheet.Name
sxParam.Automatikprozess = True
Sheets("Master").Rows("1:4").Copy
Sheets(temp).Cells(1, 1).Select
Sheets(temp).Paste
Sheets("Master").Activate
Sheets("Master").Select
ActiveSheet.Shapes.Range(Array("Home", "Hilfe", "Update")).Select
Selection.Copy
Sheets(temp).Select
Sheets(temp).Activate
Range("C4").Select
ActiveSheet.Paste
Range("J1:J4").Select
Selection.Delete
sxParam.Automatikprozess = False
End Sub
Sub style_benenne_labels()
Dim w As Worksheet
Set w = Application.ActiveSheet()
With w
'Home Label formatieren
.Label3.Name = "Home"
'Hilfe Label formatieren
.Label1.Name = "Hilfe"
'Update Label formatieren
.Label2.Name = "Update"
End With
Set w = Nothing
End Sub
Sub style_setze_Styleguide_um()
'Styleguide darf in Developeransicht ausgeführt werden ! Sonst falsche Labelpositionierung
Dim w As Worksheet
Dim temp As String
temp = ActiveSheet.Name
Application.ScreenUpdating = False
sxParam.Automatikprozess = True
For Each w In Worksheets()
On Error Resume Next
w.Activate
'Layoutcode umsetzen, falls in B1 definiert
Select Case Cells(1, 2).Value
Case "PP"
'Erste Spalte
Cells(1, 1).EntireColumn.ColumnWidth = 1
'Titelzeile
Cells(2, 1).EntireRow.Interior.Color = RGB(255, 255, 153)
Cells(2, 1).EntireRow.RowHeight = 25
'Infozeile
Cells(3, 1).EntireRow.Interior.Color = RGB(255, 255, 102)
Cells(3, 1).EntireRow.RowHeight = 15
'Titelzeile
Cells(4, 1).EntireRow.Interior.Color = RGB(255, 192, 0)
Cells(4, 1).EntireRow.RowHeight = 20
'Hintergrundfarbe Labels
With ActiveSheet
'Home Label
.Home.BackColor = RGB(255, 192, 0)
.Home.Height = 15
.Home.Top = 60
.Home.Left = 16
.Home.Width = 111
'Hilfe Label
.Hilfe.BackColor = RGB(255, 192, 0)
.Hilfe.Height = 13
.Hilfe.Top = 62
.Hilfe.Left = 142
.Hilfe.Width = 100
'Update Label
.Update.BackColor = RGB(255, 192, 0)
.Update.Height = 13
.Update.Top = 62
.Update.Left = 245
.Update.Width = 110
End With
Case "DWH"
'Erste Spalte
Cells(1, 1).EntireColumn.ColumnWidth = 1
'Titelzeile
Cells(2, 1).EntireRow.Interior.Color = RGB(197, 217, 214)
Cells(2, 1).EntireRow.RowHeight = 25
'Infozeile
Cells(3, 1).EntireRow.Interior.Color = RGB(149, 179, 214)
Cells(3, 1).EntireRow.RowHeight = 15
'Titelzeile
Cells(4, 1).EntireRow.Interior.Color = RGB(22, 54, 92)
Cells(4, 1).EntireRow.RowHeight = 20
'Hintergrundfarbe Labels
With ActiveSheet
'Home Label
.Home.BackColor = RGB(22, 54, 92)
.Home.Height = 15
.Home.Top = 60
.Home.Left = 13
.Home.Width = 111
'Hilfe Label
.Hilfe.BackColor = RGB(22, 54, 92)
.Hilfe.Height = 13
.Hilfe.Top = 62
.Hilfe.Left = 142
.Hilfe.Width = 100
'Update Label
.Update.BackColor = RGB(22, 54, 92)
.Update.Height = 13
.Update.Top = 62
.Update.Left = 245
.Update.Width = 110
End With
End Select
Next w
Set w = Nothing
Worksheets(temp).Activate
sxParam.Automatikprozess = False
Application.ScreenUpdating = True
End Sub