Zellen sperren

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema CommandButton
Screenshot zu CommandButton	CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Zellen sperren

Zellen sperren von Marc Andreas Blanke vom 18.10.2020 16:27:37

AW: Zellen sperren - von Hajo_Zi am 18.10.2020 16:30:54
- AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 16:35:02
  - AW: Zellen sperren - von Hajo_Zi am 18.10.2020 16:44:40
    - AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 17:00:30
      - AW: Zellen sperren - von Hajo_Zi am 18.10.2020 17:06:06
        
        AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 17:24:05
        
        AW: Zellen sperren - von Hajo_Zi am 18.10.2020 17:26:00
        
        AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 17:32:05
        
        AW: Zellen sperren - von Nepumuk am 18.10.2020 17:51:19
        
        AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 17:59:57
        
        AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 18:07:15
        
        AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 19:00:37
        
        AW: Zellen sperren - von Nepumuk am 18.10.2020 19:41:30
        
        AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 19:57:43
        
        AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 20:23:01
        
        AW: Zellen sperren - von Marc Andreas Blanke am 18.10.2020 20:57:29

Betrifft: Zellen sperren von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 16:27:37

Hallo zusammen,
ich möchte gerne, dass Zellen gesperrt werden wenn eine Bedingung erfüllt ist.
Über Datenprüfung/Gültigkeit habe ich aber schon eine Liste angelegt was nur ausgewählt werden darf. (Zahlen von 1-3)
Somit fällt diese Möglichkeit wohl weg???
Konkret heißt das:
WENN in G9 ein nein steht, dann sollen die Zellen F12-F50 gesperrt werden.
Gleichzeitig soll aber nur die Möglichkeit der Eingabe von Zahlen 1, 2, 3 bestehen wenn in G9 ein ja steht.
Geht das irgendwie?
Danke an alle für Eure Hilfe im Voraus.
Gruß Marc

Betrifft: AW: Zellen sperren
von: Hajo_Zi
Geschrieben am: 18.10.2020 16:30:54

Hallo Marc,

ja, VBA, ist G9 eine Eingabe?

Grußformel

Betrifft: AW: Zellen sperren
von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 16:35:02

Hallo Hajo,
danke für Deine Antwort.
G9 ist die Zelle, wo ich ja und nein auswählen kann.
Gruß Marc

Betrifft: AW: Zellen sperren
von: Hajo_Zi
Geschrieben am: 18.10.2020 16:44:40

Hallo Marc,

starte den VBA Editor (Alt+F11), Bild sollte zweigeteilt sein ansonsten Strg+R, Doppelklick auf Deine Datei, Doppelklick auf Deine Tabelle, Code ins rechte Fenster kopieren, VBA Editor schließen.
Das Makro wird automatisch gestartet.
Der Code wirkt nur in dieser Tabelle.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$G$9" Then
        ActiveSheet.Unprotect
        Range("F12:F50").Locked = Target = "Nein"
        ActiveSheet.Protect
    End If
End Sub

Gruß Hajo

Betrifft: AW: Zellen sperren
von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 17:00:30

Hallo Hajo,
das funktioniert irgendwie gar nicht.
Keine Ahnung warum.
Gruß Marc

Betrifft: AW: Zellen sperren
von: Hajo_Zi
Geschrieben am: 18.10.2020 17:06:06

Hallo Marc,

Zu Deiner Datei kann ich nichts schreiben, was wohl daran liegt das ich nicht auf fremde Rechner schaue.Ich baue keine Datei nach.

Sollte die Datei verlinkt werden?

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
http://www.ms-office-forum.de/forum/showthread.php?t=322895
änderrn.

Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.

http://www.excel-ist-sexy.de/bilder-statt-datei/

Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.

Das ist nur meine Meinung zu dem Thema.

Gruß Hajo

Betrifft: AW: Zellen sperren
von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 17:24:05

Hallo Hajo,
anbei mal die Datei. Ist auch doof ohne.
Gruß Marc
https://www.herber.de/bbs/user/140948.xlsx

Betrifft: AW: Zellen sperren
von: Hajo_Zi
Geschrieben am: 18.10.2020 17:26:00

ich kann Dir Leider nicht helfen, da bei mir eine XLSX Datei kein Makro enthält. Mein Makro ist also niucht da.
Da ich nicht für den Papierkorb arbeite bin ich raus.
Vierl Erfolg noch.

Gruß Hajo

Betrifft: AW: Zellen sperren
von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 17:32:05

Hallo Hajo,
schade. Aber trotzdem vielen Dank.
Gruß Marc

Betrifft: AW: Zellen sperren
von: Nepumuk
Geschrieben am: 18.10.2020 17:51:19

Hallo Marc,

Hajo einfach ignorieren.

Teste mal:

https://www.herber.de/bbs/user/140952.xlsm

Gruß
Nepumuk

Betrifft: AW: Zellen sperren
von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 17:59:57

Hallo Nepumuk,
genial. Genau so hatte ich mir das gewünscht.
Tausend Dank an Dich.
Kurze Frage noch: Was hat das mit Password:="GEHEIM" auf sich?
Gruß Marc

Betrifft: AW: Zellen sperren
von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 18:07:15

Hallo Nepumuk,
hat sich erledigt.
Habs rausgenommen.
Danke nochmal.
Gruß Marc

Betrifft: AW: Zellen sperren
von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 19:00:37

Hallo Nepumuk,
kurze Frage: hast Du vielleicht ne Idde warum der Code von Dir in einem anderen Tabellenblatt von mir nicht funzt?
Hier mal der VBA Code.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$G$9" Then
        Unprotect
        Range("F12:F500").Locked = Target.Text = "Doppel (entfällt)"
        Protect
    End If
End Sub

Private Sub CommandButton1_Click()
ActiveSheet.Unprotect
If [A1,A3,A4].Value = 0 Then
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 5
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Range("H2:H7").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Fett"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = 255
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
If [A4].Value = 1 Or [A5].Value = 1 Then
Range("H2:H7").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Fett"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
End If
End If
ActiveSheet.Protect
Range("B6").Select
End Sub

Stört sich da irgendetwas gegenseitig?
"nein" habe ich durch "Doppel (entfällt)" ersetzt.

Gruß Marc
https://www.herber.de/bbs/user/140955.xlsx

Betrifft: AW: Zellen sperren
von: Nepumuk
Geschrieben am: 18.10.2020 19:41:30

Hallo Marc,

da ist eine Formel drin. Daher:

Option Explicit

Private Sub Worksheet_Calculate()
    Unprotect
    Range("F12:F500").Locked = Cells(9, 7).Text = "Doppel (entfällt)"
    Protect
End Sub

Private Sub CommandButton1_Click()

    If Cells(1, 1).Value + Cells(3, 1).Value + Cells(4, 1).Value = 0 Then

        Unprotect

        Application.Wait Time + TimeSerial(0, 0, 5)

        With Range("H2:H7").Font

            .Name = "Arial"
            .FontStyle = "Fett"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .Color = 255
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone

        End With

        If Cells(4, 1).Value = 1 Or Cells(5, 1).Value = 1 Then

            With Range("H2:H7").Font

                .Name = "Arial"
                .FontStyle = "Fett"
                .Size = 8
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone

            End With
        End If

        Protect

    End If
End Sub

Gruß
Nepumuk

Betrifft: AW: Zellen sperren
von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 19:57:43

Hallo Nepumuk,
supi.
Läuft einwandfrei.....
Nochmals Danke für Deine Mühe/Hilfe.
Gruß Marc

Betrifft: AW: Zellen sperren
von: Marc Andreas Blanke
Geschrieben am: 18.10.2020 20:23:01

Hallo Nepumuk,
kurze Frage: mein Makro zum löschen funzt jetzt nicht mehr, obwohl ich am Anfang den Blattschutz aufhebe.
Hast Du da auch ne Idee zu.
Hier der VBA Code:

Sub Aufstellung_Gast_löschen()
'
' Aufstellung_Gast_löschen Makro
'

'
    ActiveSheet.Unprotect
    Range("D12:D500").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-99
    Range("F12:F500").Select
    Selection.ClearContents
    Range("J12:J500").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-102
    Range("H2:H7").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Fett"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    ActiveSheet.Protect
    End With
If [A2].Value >= 1 Or [A2].Value >= 0 Then
    Range("D12").Select
End If
If [A2].Value >= 2 Then
    Range("D63").Select
    ActiveWindow.SmallScroll Down:=51
End If
If [A2].Value >= 3 Then
    Range("D113").Select
    ActiveWindow.SmallScroll Down:=25
End If
If [A2].Value >= 4 Then
    Range("D167").Select
    ActiveWindow.SmallScroll Down:=54
End If
If [A2].Value >= 5 Then
    Range("D223").Select
    ActiveWindow.SmallScroll Down:=56
End If
If [A2].Value >= 6 Then
    Range("D272").Select
    ActiveWindow.SmallScroll Down:=49
End If
If [A2].Value >= 7 Then
    Range("D323").Select
    ActiveWindow.SmallScroll Down:=51
End If
If [A2].Value >= 8 Then
    Range("D374").Select
    ActiveWindow.SmallScroll Down:=51
    ActiveSheet.Protect
End If
End Sub

Bei Range("F12:F500").Select bleit er stehen.
Ich verstehe nur nicht warum, da ich ja den Schutz aufhebe.

Gruß Marc