Textausgabe wenn Makro ausgeführt wurde ... ?

Question

Hallo, guten Morgen,

ich benötige mal wieder Eure Hilfe .....

Ich habe eine Tabelle mit diversen Befehlsschaltflächen, nun möchte ich wenn z.B. die Schaltfläche "Alle Arbeitsblätter schützen" ausgeführt wurde in der Zelle F3 desselben Blattes die Ausgabe "Arbeitsblätter sind geschützt".

Ich kriege es mal wieder nicht hin ;-( und finde auch im Internet keine entsprechende Hilfe ...


Das Makro sieht folgendermassen aus:

Sub Passwortabfrage_BlattSchutz_EIN()
Dim Passwort As String, Vergleichspasswort As String
Vergleichspasswort = "159"
Passwort = InputBox("Bitte Passwort Eingeben", "Passwortabfrage")
If Passwort <> Vergleichspasswort Then MsgBox "Passwort falsch"
Exit Sub
Dim s
Application.ScreenUpdating = False
For s = 1 To Sheets.Count
Sheets(s).Protect
Next s
Application.ScreenUpdating = True
End Sub


Hoffe auf Hilfe und vielen Dank schonmal ....

Gruss - Petra

Answer 1

Hallo Petra,

probier's mal so

Option Explicit

Sub Passwortabfrage_BlattSchutz_EIN()
Dim strPasswort As String, strVergleichspasswort As String
Dim intS As Integer
strVergleichspasswort = "159"
strPasswort = InputBox("Bitte Passwort Eingeben", "Passwortabfrage")
If strPasswort <> strVergleichspasswort Then
MsgBox "Passwort falsch"
Exit Sub
End If
Application.ScreenUpdating = False
For intS = 1 To Sheets.Count
With Worksheets(intS)
.Cells(3, 6).Value = "Arbeitsblätter sind geschützt"
.Protect
End With
Next
Application.ScreenUpdating = True
End Sub

Gruß
Rainer

Answer 2

Hallo Rainer,

Grundsätzlich funktioniert es, allerdings kommt die Fehlermeldung

Anwendungs- oder Objektdefinierter Fehler,

dieser bezieht sich auf:
.Cells(3, 6).Value = "Arbeitsblätter sind geschützt"


Hast Du eine Ahnung woran das liegt??

Gruss - Petra

Answer 3

... ich vergass noch folgendes,

kann man da noch einbauen, dass das Feld vorher geleert wird, da ich dort noch andere Meldungen ausgeben möchte ????

Answer 4

Hallo Petra,

bei mir gab es keine Fehlermeldung, aber probier's mal so.

Option Explicit

Sub Passwortabfrage_BlattSchutz_EIN()
Dim strPasswort As String, strVergleichspasswort As String
Dim intS As Integer
strVergleichspasswort = "159"
strPasswort = InputBox("Bitte Passwort Eingeben", "Passwortabfrage")
If strPasswort <> strVergleichspasswort Then
MsgBox "Passwort falsch"
Exit Sub
End If
Application.ScreenUpdating = False
For intS = 1 To Sheets.Count
Worksheets(intS).Cells(3, 6).Value = "Arbeitsblätter sind geschützt"
Sheets(intS).Protect
Next
Application.ScreenUpdating = True
End Sub

kann man da noch einbauen, dass das Feld vorher geleert wird, da ich dort noch andere Meldungen ausgeben möchte ????

....den Satz verstehe ich nicht, es ist doch egal, ob in F3 bereits etwas steht oder stand, "Arbeitsblätter sind geschützt" wird doch in jedem Fall ausgegeben.

Gruß
Rainer

Answer 5

Hallo Rainer,

vielleicht sind einige Tabellen schon geschützt?

Gruß Hajo

Answer 6

Hallo nochmal,

@Hajo

ich bin davon ausgegangen, dass das nicht so ist.

@Petra
wenn Hajo's Vermutung zutrifft, dann so

Option Explicit

Sub Passwortabfrage_BlattSchutz_EIN()
Dim strPasswort As String, strVergleichspasswort As String
Dim intS As Integer
strVergleichspasswort = "159"
strPasswort = InputBox("Bitte Passwort Eingeben", "Passwortabfrage")
If strPasswort <> strVergleichspasswort Then
MsgBox "Passwort falsch"
Exit Sub
End If
Application.ScreenUpdating = False
For intS = 1 To Sheets.Count
Sheets(intS).Unprotect
Worksheets(intS).Cells(3, 6).Value = "Arbeitsblätter sind geschützt"
Sheets(intS).Protect
Next
Application.ScreenUpdating = True
End Sub

Gruß
Rainer

Answer 7

@Hajo:
normalerweise sind entweder alle Blätter geschützt, oder alle Blätter nicht geschützt. Habe mir entpsrechende Schaltflächen erstellt.

@Rainer:
vielen Dank für das Makro - funktioniert einwandfrei ;-)
Und zwar beide Varianten ...!
Habe mich (vorsichtshalber, falls doch nicht alle Tabellen geschützt sind) für das 2. Makro enschieden.

Ich denke das Problem lag an meinem PC - es funktionierte nämlich auf einmal KEIN Makro mehr, nach einem Neustart ist nun alles wieder OK.

....den Satz verstehe ich nicht, es ist doch egal, ob in F3 bereits etwas steht oder stand, "Arbeitsblätter sind geschützt" wird doch in jedem Fall ausgegeben.

Richtig - mal wieder ein Denkfehler von mir - sorry.
Hin und wieder "drehe ich mich im Kreis" ... ;-(


Vielen, vielen Dank und viele Grüße
Petra

Answer 8

Hallo,

;-( nun habe ich doch noch ein Problem.

Ich habe weitere Markos eingebaut (z. B. Zellen ausblenden), in denen ich vorher den Blattschutz entfernen muss, daher funktioniert oben stehendes Makro nicht mehr ganz korrekt.

Es schreibt auch in die betroffenen Blätter "Arbeitsblätter sind geschützt".

Kann man die Zeile:

Worksheets(intS).Cells(3, 6).Value = "Arbeitsblätter sind geschützt"

so abändern, dass der Text nur in dem Blatt MAKROS erscheint??

habe es schon mit Sheets("MAKROS")..... probiert - haut leider nicht hin. Wie kann ich mich auf das Blatt beziehen ???

Gruss - Petra

Answer 9

Hallo Petra,

das wüede ich dann so machen

Option Explicit

Sub Passwortabfrage_BlattSchutz_EIN()
Dim strPasswort As String, strVergleichspasswort As String
Dim intS As Integer
strVergleichspasswort = "159"
strPasswort = InputBox("Bitte Passwort Eingeben", "Passwortabfrage")
If strPasswort <> strVergleichspasswort Then
MsgBox "Passwort falsch"
Exit Sub
End If
Application.ScreenUpdating = False
For intS = 1 To Sheets.Count
Sheets(intS).Unprotect
If Worksheets(intS).Name = "MAKROS" Then
Worksheets(intS).Cells(3, 6).Value = "Arbeitsblätter sind geschützt"
Sheets(intS).Protect
Else
Sheets(intS).Protect
End If
Next
Application.ScreenUpdating = True
End Sub

Gruß
Rainer

Answer 10

Hallo Rainer,

es funktioniert einfach nicht (könnte heulen) ......

Ich habe mal 2 Tabellen hochgeladen, die 1. Tabelle (Kunden) dient nur der Datenübernahme in die 2. Tabelle (Behandlungen).

In der 2. Tabelle sind die Makros hinterlegt.

Wäre toll wenn es eine Lösung geben würde......

Tabelle 1:
www.file-upload.net/download-1696409/MB_Kunden.xls.html

Tabelle 2:
www.file-upload.net/download-1696414/MB_Behandlungen.xls.html

Gruss - Petra