Microsoft Excel

Herbers Excel/VBA-Archiv

Mamut-Code

Betrifft: Mamut-Code von: Frank
Geschrieben am: 07.09.2004 10:29:22

Hallole,

kann man diese beiden Code verkleinern???????????


Sub Schutz_Ein()
'
' Schutz_Ein Makro
' Makro am 07.09.2004 von FE aufgezeichnet
'

'
Application.ScreenUpdating = False
Sheets("Auswahl").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Startseite").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Einzelsummen").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gesamtberechnung").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 3").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 4").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 4").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 4").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 4").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 4").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 5").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 5").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 5").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 5").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 5").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 7").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 7").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 7").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 7").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 7").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 8").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 8").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 8").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 8").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 8").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 9").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 9").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 9").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 9").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 9").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Blindplatten 10").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Diverses 10").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Frontplatten 10").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Gehäuse 10").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("MA Rückwand 10").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Info").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Administrator").Select
Range("A2").Select
Application.ScreenUpdating = True
End Sub

Sub Schutz_Aus()
'
' Schutz_Aus Makro
' Makro am 07.09.2004 von FE aufgezeichnet
'

'
    Application.ScreenUpdating = False
    Sheets("Auswahl").Select
    ActiveSheet.Unprotect
    Sheets("Einzelsummen").Select
    ActiveSheet.Unprotect
    Sheets("Startseite").Select
    ActiveSheet.Unprotect
    Sheets("MA Gesamtberechnung").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 1").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 1").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 1").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 1").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 1").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 2").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 2").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 2").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 2").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 2").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 3").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 3").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 3").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 3").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 3").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 4").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 4").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 4").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 4").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 4").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 5").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 5").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 5").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 5").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 5").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 6").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 6").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 6").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 6").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 6").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 7").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 7").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 7").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 7").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 7").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 8").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 8").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 8").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 8").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 8").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 9").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 9").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 9").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 9").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 9").Select
    ActiveSheet.Unprotect
    Sheets("MA Blindplatten 10").Select
    ActiveSheet.Unprotect
    Sheets("MA Diverses 10").Select
    ActiveSheet.Unprotect
    Sheets("MA Frontplatten 10").Select
    ActiveSheet.Unprotect
    Sheets("MA Gehäuse 10").Select
    ActiveSheet.Unprotect
    Sheets("MA Rückwand 10").Select
    ActiveSheet.Unprotect
    Sheets("Info").Select
    ActiveSheet.Unprotect
    Sheets("Administrator").Select
    Range("A2").Select
    Application.ScreenUpdating = True
    End Sub


Gruß
Frank
  


Betrifft: AW: Mamut-Code von: Marko
Geschrieben am: 07.09.2004 10:40:01

Hi Frank,

Das hier legt die Namen aller Worksheets (außer zweien) im Array workbks ab.

Dim workbks(100)
anzahl = ActiveWorkbook.Worksheets.Count
anzwerkst = 0
For i = 1 To anzahl
wname = ActiveWorkbook.Worksheets(i).Name
If UCase(wname) = "das_nicht" Then GoTo nowkst
If UCase(wname) = "das_auch_nicht" Then GoTo nowkst
anzwerkst = anzwerkst + 1
workbks(anzwerkst) = wname
nowkst:
Next i

Stattdessen könnte man da natürlich auch

Sheets(wname).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

einfügen.

Gruß Marko


  


Betrifft: AW: Mamut-Code von: Marko
Geschrieben am: 07.09.2004 10:41:00

Hi Frank,

Das hier legt die Namen aller Worksheets (außer zweien) im Array workbks ab.

Dim workbks(100)
anzahl = ActiveWorkbook.Worksheets.Count
anzwerkst = 0
For i = 1 To anzahl
wname = ActiveWorkbook.Worksheets(i).Name
If UCase(wname) = "DAS_NICHT" Then GoTo nowkst
If UCase(wname) = "DAS_AUCH_NICHT" Then GoTo nowkst
anzwerkst = anzwerkst + 1
workbks(anzwerkst) = wname
nowkst:
Next i

Stattdessen könnte man da natürlich auch

Sheets(wname).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

einfügen.

Gruß Marko


  


Betrifft: AW: Mamut-Code von: Russi
Geschrieben am: 07.09.2004 10:41:27

Hallo Frank!

Behandelt der Code alle Tabellenblätter der Datei?!? Dann kannst Du genauso gut folgende Schleife verwenden:

ub alleblaetterschuetzen()
For Each blatt In ActiveWorkbook.Sheets
blatt.Protect DrawingObjects:=True, Scenarios:=True
Next
End Sub

Sub alleblaetterschutzentfernen()
For Each blatt In ActiveWorkbook.Sheets
    blatt.Unprotect
Next
End Sub


Viele Grüße
Russi
www.Russi.de.tt


  


Betrifft: AW: Mamut-Code von: Frank
Geschrieben am: 07.09.2004 10:49:42

Der Code behandelt alle Tabellenblätter bis auf das erste Tabellenblatt

Gruß
Frank


  


Betrifft: AW: Mamut-Code von: Dieter Maj
Geschrieben am: 07.09.2004 10:43:00

Hallo Frank
oder so, als kleiner Denkanstoss:
Sub rein()
Dim i
Dim j
i = Sheets.Count
For j = 1 To i
Sheets(j).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
End Sub


Sub raus()
Dim i
Dim j
i = Sheets.Count
For j = 1 To i
Sheets(j).Unprotect
Next
End Sub


Gruß Dieter


  


Betrifft: Danke von: Frank
Geschrieben am: 07.09.2004 10:59:07

Danke an Dieter und alle anderen für die Lösungvorschläge,

Funktioniert wunderbar

Gruß
Frank