Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 11:49:48
VAB und Bedingte Formatierung nimmt die Farbe im Makro nicht
26.04.2024 11:38:46
Acrobat PDF Formularfelder mit Excel ausfüllen
26.04.2024 11:23:04
zählen wenn - aber nur die selektierten Zeilen
26.04.2024 10:08:11
Summieren von Zellen mit bedingter Formatierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
992to996
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
992to996
992to996
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Blattschutz in Makro integrieren

Blattschutz in Makro integrieren
21.07.2008 10:44:01
Tobi
Hallo zusammen,
ich habe ein Makro mit welchem ich, per Mausklick auf einen Button, Daten von einer Exceldatei in meine Exceldatei (Planung.xls) spiele. Meine Planung.xls hat einen Blattschutz welchen ich über Extras > Schutz > Blattschutz aufheben entfernen kann. Das Passwort ist "test".
Gerne würde ich ein Makro in meinem bestehenden integrieren, welches mir beim Mausklick auf den Button den Blattschutz entfernt und wenn alle Daten in die Datei Planung.xls gespielt wurden, den Blattschutz wieder aktiviert.
Kann mir vielleicht jemand helfen wie ich das Makro machen kann? Vielleicht kann mir jemand sagen an welcher stelle ich das Makro um den Blattschutz aufzuheben einfügen muss und wie es aussieht?
Vielen Dank im Voraus für Euere Hilfe.
Viele Grüße
Tobi
" 

Sub LoadButton_Click()
Dim Prod As Worksheet
Dim filetoopen As String
Application.ScreenUpdating = False
ChDrive "I"
ChDir "I:\B Beteiligungscontrolling\F_Team BTC\Diplomanden\Leyhr\20 Diplomarbeit\50  _
Planungstool\aktuell"
filetoopen = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If filetoopen  "False" And filetoopen  "Falsch" And filetoopen  "" Then
Workbooks.Open filetoopen
With ActiveWorkbook
'CF
Set CF = ThisWorkbook.Sheets("CF")
.Sheets("CF").Range("C41").Copy
CF.Range("C7").PasteSpecial Paste:=xlPasteValues
'Produktion
Set Prod = ThisWorkbook.Sheets("Prod")
.Sheets("Prod").Range("A:A").Copy Destination:=Prod.Range("A:A")
.Sheets("Prod").Range("B:B").Copy Destination:=Prod.Range("B:B")
.Sheets("Prod").Range("D:D").Copy Destination:=Prod.Range("BD:BD")
.Sheets("Prod").Range("E:E").Copy Destination:=Prod.Range("BE:BE")
.Sheets("Prod").Range("F:F").Copy Destination:=Prod.Range("BF:BF")
'Umsatz
Set Rev = ThisWorkbook.Sheets("Rev")
.Sheets("Rev").Range("A:A").Copy Destination:=Rev.Range("A:A")
.Sheets("Rev").Range("B:B").Copy Destination:=Rev.Range("B:B")
.Sheets("Rev").Range("C:C").Copy Destination:=Rev.Range("C:C")
.Close
End With
End If
Application.ScreenUpdating = True
End Sub


8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Blattschutz in Makro integrieren
21.07.2008 10:57:00
Tobi
Hallo,
ich habe ganz vergessen, dass ich insgesamt 12 Reiter (Blätter) in meiner Exceldatei habe. Bei allen soll der Blattschutz aufgehoben werden und alles sollen dann nach ablauf des makros wieder geschützt werden.
vielen dank dür euere hilfe im voraus
viele grüße
tobi

AW: Blattschutz in Makro integrieren
21.07.2008 11:00:00
David
Du aktivierst (falls noch nicht vorhanden) die Symbolleiste "Steuerelement Toolbox", erstellst damit eine neue Befehlsschaltfläche. Auf diese machst du einen Doppelklick und in dem erscheinenden Fenster kopierst du den Code rein.
Wenn du dann den Entwurfmodus ausschaltest, wird der Code beim Klick auf die Schaltfläche ausgeführt. Den Text auf dem Button kannst du übrigens über Rechtsklick, Eigenschaften und dann die Zeile "Caption" ändern.
Rückmeldung ob's hilft wäre nett.
Gruß
David

Anzeige
AW: Blattschutz in Makro integrieren
21.07.2008 11:04:54
mumpel
Hallo!
Du musst nur noch das Kennwort anpassen (in Anführunszeichen). Alle Blätter müssen aber das selbe Kennwort haben.
Sub LoadButton_Click()
For Each Blatt In Worksheets
Blatt.Unprotect "DeinKennwort" 'Kennwort anpassen (in Anführungszeichen) 
Next Blatt
Dim Prod As Worksheet
Dim filetoopen As String

  Application.ScreenUpdating = False
  
  ChDrive "I"
  ChDir "I:\B Beteiligungscontrolling\F_Team BTC\Diplomanden\Leyhr\20 Diplomarbeit\50 Planungstool\aktuell"
  filetoopen = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
  If filetoopen <> "False" And filetoopen <> "Falsch" And filetoopen <> "" Then
    Workbooks.Open filetoopen
    
     With ActiveWorkbook
     
    'CF 
    Set CF = ThisWorkbook.Sheets("CF")
    .Sheets("CF").Range("C41").Copy
    CF.Range("C7").PasteSpecial Paste:=xlPasteValues
     
    'Produktion 
    Set Prod = ThisWorkbook.Sheets("Prod")
   
      .Sheets("Prod").Range("A:A").Copy Destination:=Prod.Range("A:A")
      .Sheets("Prod").Range("B:B").Copy Destination:=Prod.Range("B:B")
      .Sheets("Prod").Range("D:D").Copy Destination:=Prod.Range("BD:BD")
      .Sheets("Prod").Range("E:E").Copy Destination:=Prod.Range("BE:BE")
      .Sheets("Prod").Range("F:F").Copy Destination:=Prod.Range("BF:BF")

    'Umsatz 
    Set Rev = ThisWorkbook.Sheets("Rev")

      .Sheets("Rev").Range("A:A").Copy Destination:=Rev.Range("A:A")
      .Sheets("Rev").Range("B:B").Copy Destination:=Rev.Range("B:B")
      .Sheets("Rev").Range("C:C").Copy Destination:=Rev.Range("C:C")

  .Close
    End With
   End If
For Each Blatt In Worksheets
Blatt.Protect "DeinKennwort" 'Kennwort anpassen (in Anführungszeichen) 
Next Blatt
  Application.ScreenUpdating = True

End Sub

Code eingefügt mit VBA in HTML 1.2 ( Hilfe zum Programm)size>
Gruß, René

Anzeige
AW: Blattschutz in Makro integrieren
21.07.2008 13:44:00
Tobi
Hallo René,
vielen Dank für deine Hilfe. Ich habe deine Zeilen eingefügt, doch leider funktioniert das Makro nicht. Es kommt immer die Nachricht: Laufzeitfehler 1004 "Das eingegebene Kennwort ist ungültig."
Das komische ist aber, dass die Blätter trotz der Nachricht nicht mehr schreibgeschützt sind. Was ja der Sinn des Makros ist. Nur leider spielt es mir die Daten aus der anderen Datei nicht mehr ein. Weißt du vielleicht wo der Fehler liegt? Anbei findest du das Makro mit welchem die Datei beim Start geschützt wird:

Private Sub Workbook_Open()
Dim wks As Worksheet
ActiveWorkbook.Protect Password:="bwpa", Structure:=True
On Error GoTo errorhandler
For Each wks In Worksheets
wks.Unprotect ("bwpa")
wks.EnableOutlining = True
wks.Protect Password:="bwpa", userinterfaceonly:=True, DrawingObjects:=False, Contents:= _
True, Scenarios:=True
Next wks
errorhandler: Exit Sub
End Sub


Die Datei habe ich von meinem Vorgänger übernommen, leider kenne mich mit den Makros nicht aus. Er hat noch zwei weiter Makros mit welchen man die Datei schreibschützen und den schutz entfernen kann. Leider kann ich diese nicht für mich übernehmen, da sie eine InputBox haben. Ich möchte gerne, dass bei meinem Makro das Passwort im Makro steht und man es nicht in eine InputBox eingeben muss.
Sub Blattschutz()
Dim wks As Worksheet
Dim strpw As String
strpw = InputBox("Password:")
If strpw = "" Then Exit Sub
On Error GoTo errorhandler
For Each wks In ThisWorkbook.Sheets
wks.EnableOutlining = True
wks.Protect Password:=strpw, userinterfaceonly:=True, DrawingObjects:=False, Contents:=True, Scenarios:=True
Next wks
errorhandler: Exit Sub
End Sub


Sub Blattschut_aufheben()
Dim wks As Worksheet
Dim strpw As String
strpw = InputBox("Password:")
On Error GoTo errorhandler
If strpw = "" Then Exit Sub
For Each wks In ThisWorkbook.Sheets
wks.Unprotect Password:=strpw
Next wks
errorhandler: Exit Sub
End Sub


Hoffe du kannst mir weiterhelfen. habe schon alles möglich versucht.
Vielen Dank für deine Hilfe im Voraus.
Viele Grüße
tobi

Anzeige
AW: Blattschutz in Makro integrieren
22.07.2008 01:21:53
mumpel
Kann ich nicht nachvollziehen, funktioniert bei mir problemlos. Bist Du sicher, dass allecolor> Tabellenblätter das selbecolor> Kennwort haben? Und hast Du das Kennwort auch angepasst?

Nachtrag
22.07.2008 01:23:34
mumpel
Sollten die Tabellen ohne Kennwort geschützt sein, dann entferne den Eintrag "DeinKennwort" einfach (auch die Anführungszeichen).

AW: Blattschutz in Makro integrieren
21.07.2008 11:12:01
done
Hallo,
in ein Modul:

Sub prcWorksheetProtection(blnProtect As Boolean, strPass As String)
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If blnProtect Then
wks.Protect strPass
Else
wks.Unprotect strPass
End If
Next
End Sub


an den Anfang deines Makros:
prcWorksheetProtection False, "test"
ans Ende:
prcWorksheetProtection True, "test"
Gruß
Rudi

Anzeige
AW: Blattschutz in Makro integrieren
21.07.2008 13:46:48
Tobi
Hallo Rudi,
vielen Dank für deine Hilfe. Ich habe deine Zeilen eingefügt, doch leider funktioniert das Makro nicht. Es kommt immer die Nachricht: Laufzeitfehler 1004 "Das eingegebene Kennwort ist ungültig."
Das komische ist aber, dass die Blätter trotz der Nachricht nicht mehr schreibgeschützt sind. Was ja der Sinn des Makros ist. Nur leider spielt es mir die Daten aus der anderen Datei nicht mehr ein. Weißt du vielleicht wo der Fehler liegt? Anbei findest du das Makro mit welchem die Datei beim Start geschützt wird:

Private Sub Workbook_Open()
Dim wks As Worksheet
ActiveWorkbook.Protect Password:="bwpa", Structure:=True
On Error GoTo errorhandler
For Each wks In Worksheets
wks.Unprotect ("bwpa")
wks.EnableOutlining = True
wks.Protect Password:="bwpa", userinterfaceonly:=True, DrawingObjects:=False, Contents:= _
True, Scenarios:=True
Next wks
errorhandler: Exit Sub
End Sub


Die Datei habe ich von meinem Vorgänger übernommen, leider kenne mich mit den Makros nicht aus. Er hat noch zwei weitere Makros mit welchen man die Datei schreibschützen und den schutz entfernen kann. Leider kann ich diese nicht für mich übernehmen, da sie eine InputBox haben. Ich möchte gerne, dass bei meinem Makro das Passwort im Makro steht und man es nicht in eine InputBox eingeben muss.
Sub Blattschutz()
Dim wks As Worksheet
Dim strpw As String
strpw = InputBox("Password:")
If strpw = "" Then Exit Sub
On Error GoTo errorhandler
For Each wks In ThisWorkbook.Sheets
wks.EnableOutlining = True
wks.Protect Password:=strpw, userinterfaceonly:=True, DrawingObjects:=False, Contents:=True, Scenarios:=True
Next wks
errorhandler: Exit Sub
End Sub


Sub Blattschut_aufheben()
Dim wks As Worksheet
Dim strpw As String
strpw = InputBox("Password:")
On Error GoTo errorhandler
If strpw = "" Then Exit Sub
For Each wks In ThisWorkbook.Sheets
wks.Unprotect Password:=strpw
Next wks
errorhandler: Exit Sub
End Sub


Hoffe du kannst mir weiterhelfen. habe schon alles möglich versucht. mein problem ist, dass ich einfach ausprobiere, aber leider keine richtigen makro kenntnisse habe.
wäre super wenn du mir helfen kannst.
Vielen Dank für deine Hilfe im Voraus.
Viele Grüße
tobi

Anzeige

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige