Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1600to1604
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
Inhaltsverzeichnis

VBA-Programm Ergänzung Schreibschutz

VBA-Programm Ergänzung Schreibschutz
05.01.2018 23:06:04
Maximus
Guten Abend/Tag,
ich habe ein VBA-Programm, womit ich in der Lage bin, in bestimmten Zellen durch Doppelklick ein X zu erzeugen (siehe unten).
Ich bräuchte folgende Ergänzung (Bedingung) in dem Programm,wenn möglich:
Wenn in D24 UND E24 je ein Wert steht, dann sollen B13 und F13 einen Schreibschutz haben, sprich dann soll es nicht möglich sein durch Doppelklick ein X zu erzeugen.
Anders ausgedrückt, wenn nur in D24 ODER E24 ein Wert steht, dann soll es weiterhin möglich sein, u.a. in B13 und F13 durch Doppelklick ein X zu erzeugen.
Vielen Dank für die Mühen!
Gruss Markus
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("A3:I3,A13:C15,E13:G20"), Target) Is Nothing Then
Application.EnableEvents = False
Target.Value = IIf(Target.Value = "x", "", "x")
Application.EnableEvents = True
Cancel = True
End If
End Sub

27
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA-Programm Ergänzung Schreibschutz
06.01.2018 06:13:59
Hajo_Zi
Hallo Markus,
D24 ODER E24 Eingaben?
Die Tabelle muss geschützt werden!

Ich gebe keinen Dank für eine Rückmeldung, da ich durch solche Beiträge nicht meine Beitragszahl erhöhen muss.
Also ich schreibe keine Beiträge mit dem Betreff "Gerne u. Danke für die Rückmeldung....."
Rückmeldung ist ja in der Heutigen Zeit nicht üblich und die wenigen die eine Rückmeldung geben,
mögen mir das verzeihen, das kein Danke für eine Rückmeldung kommt.
Beiträge von Werner, Luc, robert und folgende lese ich nicht.
AW: VBA-Programm Ergänzung Schreibschutz
06.01.2018 08:35:47
Maximus
Hi,
ich versuche die Ergänzung nochmals zu beschreiben:
Bedingung:
Wenn in den Zellen D24 UND E24 ein Wert eingetragen ist, dann soll es nicht möglich sein, in B13 UND F13 einen Eintrag vorzunehmen!
Wenn nur in D24 ODER E24 ein Wert eingetragen, also eine der beiden Zellen kein Eintrag hat, dann soll die Bedingung der Sperre nicht gelten.
Kann man so eine Bedingung in dem VBA-Programm zusätzlich integrieren?
Gruss und Danke Markus
Anzeige
prüfe mit Anzahl2(COUNTA) auf 2 owT
06.01.2018 08:39:42
Matthias
AW: prüfe mit Anzahl2(COUNTA) auf 2 owT
06.01.2018 08:46:16
Maximus
Besteht die Möglichkeit, diese Bedingung im VBA-Programm durch eine Ergänzung hinzubekommen?
Ja ...
06.01.2018 08:48:38
Matthias

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("B13,F13"), Target) Is Nothing Then
Cancel = True
If Application.WorksheetFunction.CountA(Range("D24:E24")) = 2 Then Exit Sub
Application.EnableEvents = False
Target.Value = IIf(Target.Value = "x", "", "x")
Application.EnableEvents = True
End If
End Sub

AW: Ja ...
07.01.2018 20:24:55
Maximus
Grüss Dich Matthias,
war absolut keine Absicht, habe deine Antwort nicht bemerkt, obwohl ich immer mal wieder reingeschaut habe.Das ist für mich ein Rätsel, dass ich das übersehen konnte. Vielen Dank für dein VBA-Programm.
Bin gerade am testen.
Immoment ist das so mit deinem Programm:
Wenn D24/E24 ein Eintrag dann sind alle Tabellen gesperrt.
Wenn D24/E24 kein Eintrag sind alle Tabellen gesperrt außer Zellen B13 und F13.
Es sollte aber so sein:
Ich habe zwei Tabellen
Tabelle 1 von A13:C13
Tabelle 2 von E13:G20
Bevor diese Sperre im VBA-Programm in Kraft tritt, muss ich in der Lage sein in A13 (Tabelle 1) UND in E13 (Tabelle2) ein X setzen zu können.
Erst dann darf die Sperre in Kraft treten, weil ein Wert in D24 und E24 steht.
Sobald ein Wert entfernt wird (D24 oder E24) sollte die Sperre aufgehoben sein.
Danke und Gruss Markus
Sorry noch mal dass ich deinen Beitrag überlesen habe.
Anzeige
AW: Ja ...
07.01.2018 20:27:44
Maximus
Jetzt weiss ich warum ich deine Antwort übersehen habe, weil auch neue Antworten nicht automatisch ganz nach hinten gesetzt werden, sondern zwischen rein; halt logischerweise als direkte Antwort.
Jetzt verstehe ich das Prinzip hier.
hier mein Bsp ...
07.01.2018 20:49:32
Matthias
Hallo
hier mein Bsp ...
https://www.herber.de/bbs/user/118759.xlsm
Musst Du halt noch bisschen umfriemeln.
Einfach mal nur zum Verstehen, wie man in etwa sowas machen könnte.
Gruß Matthias
AW: hier mein Bsp ...
07.01.2018 21:09:06
Maximus
Danke Matthias,
sieht gut aus! DANKE!
Ich bin die ganze Zeit am überlegen, wie ich folgende Änderung hinbekomme, damit ich den VBA-Code für meinen Vordruck benutzen kann.
- In A3:I9 darf kein Schutz sein!
- In A13 und E13 darf kein Schutz sein!
Weil hier Einträge vorgenommen werden BEVOR der Eintrag in D24/E24 entfernt wird!
Gruss Markus
Anzeige
AW: VBA-Programm Ergänzung Schreibschutz
06.01.2018 08:53:49
Hajo_Zi
Hallo Markus,
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "D24" Or Target.Address(False, False) = "E24" Then
ActiveSheet.Unprotect
Application.EnableEvents = False
Range("B13") = Range("D24") Or Range("E24")
Range("F13") = Range("D24") Or Range("E24")
Application.EnableEvents = True
ActiveSheet.Protect
End If
End Sub
Gruß Hajo
AW: VBA-Programm Ergänzung Schreibschutz
06.01.2018 09:15:59
Maximus
Hi Hajo,
habe versucht deine Ergänzung mit dem vorhandenen Programm zu verbinden, aber dann bekomme ich eine Fehlermeldung.
So habe ich es eingegeben:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address(False, False) = "D24" Or Target.Address(False, False) = "E24" Then
ActiveSheet.Unprotect
Application.EnableEvents = False
Range("B13") = Range("D24") Or Range("E24")
Range("F13") = Range("D24") Or Range("E24")
Application.EnableEvents = True
ActiveSheet.Protect
End Select
End With
If Not Intersect(Range("A3:I3,A13:C15,E13:G20"), Target) Is Nothing Then
Application.EnableEvents = False
Target.Value = IIf(Target.Value = "x", "", "x")
Application.EnableEvents = True
Cancel = True
End If
End 

Anzeige
AW: VBA-Programm Ergänzung Schreibschutz
06.01.2018 09:22:40
Hajo_Zi
Gut Mein Vorschlag gefiel Dir also nicht. Gut Dann musst Du sehen wie Du weiter machst. Ich bin dann raus da mein Vorschlag nicht mehr relevant.
Gruß Hajo
AW: VBA-Programm Ergänzung Schreibschutz
06.01.2018 09:28:59
Maximus
Hi,
ich hatte das so verstanden, dass dein Programm eine Ergänzung zu dem vorhanden Programm ist.
Weil mit deinem Programm alleine bekomme ich durch Doppelklick kein X mehr in die entsprechenden Zellen, was ich auch getestet habe.
Somit bin ich davon ausgegangen, dass dein Programm mit dem verhandenen verbunden werden muß, was ich getan habe; aber nicht funktioniert-bis jetzt.
Gruß
Anzeige
AW: VBA-Programm Ergänzung Schreibschutz
07.01.2018 12:35:49
Steve
Hallo Maximus.
Versuche mal deinen Code durch diesen zu ersetzen.............
mfg STeve
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("A3:I3,A13:C15,E13:G20"), Target) Is Nothing Then
ActiveSheet.Unprotect
If Application.WorksheetFunction.CountA(Range("D24:E24")) = 2 Then GoTo sindbefuellt
Target.Value = IIf(Target.Value = "x", "", "x")
Cancel = True
ActiveSheet.Protect
Exit Sub
sindbefuellt:
If Not Intersect(Range("E13:B13"), Target) Is Nothing Then GoTo sperre
Target.Value = IIf(Target.Value = "x", "", "x")
Cancel = True
End If
sperre:
ActiveSheet.Protect
End Sub

Anzeige
AW: VBA-Programm Ergänzung Schreibschutz
07.01.2018 19:22:25
Maximus
Vielen Dank Steve für das VBA-Programm,
dein Programm setzt die Bedingung gut um. Doch ich hätte zur Bedingung noch was schreiben müssen.
Ich habe zwei Tabellen
Tabelle 1 von A13:C13
Tabelle 2 von E13:G20
Bevor diese Sperre im VBA-Programm in Kraft tritt, muss ich in der Lage sein in A13 (Tabelle 1) UND in E13 (Tabelle2) ein X setzen zu können.
Erst dann darf die Sperre in Kraft treten, weil ein Wert in D24 und E24 steht.
Es ist bis jetzt gut umgesetzt, dass die Sperre aufgelöst wird, wenn der Wert aus D24 ODER E24 entfernt worden ist.
Ich habe schon versucht das VBA-Programm dahingehend zu ändern, aber klappt bei mir nicht.
Wäre super wenn du dir das nochmals amschauen könntest.
Vielen Dank und Gruss Markus
Bei der dritten Tabelle (A3:I3)kann ich schon bei deinem jetzigen VBA-Programm trotz Zellenschutz ein X setzen; was gut ist. Diese Tabelle ist von dem Tabellenschutz gar nicht betroffen!
Anzeige
mit mir wolltest Du gestern nicht mehr "reden"?
07.01.2018 19:41:21
Matthias
Hallo
Ich habe seit gestern 08:48 auf eine Rückmeldung gewartet, warum kam da nichts?
Ich habe gestern eine Bsp.Datei erstellt und nur auf (D)eine Rückmeldung gewartet.
Solltest Du doch noch Interesse an (m)einer Bsp.Datei haben,
musst Du einfach auch mal antworten, denn sonst lösche ich sie wieder.
Gruß Matthias
Antwort an euch beide.....
07.01.2018 20:51:36
STeve
Hallo Maximus und s.g. Matthias L
@ Maximus: Ersuche Matthias L um seine Beispieldatei....er ist ein absoluter Könner. Denke er wird dein Problem - auch mit deinen neuen Angaben - schnell und perfekt lösen können.
Grüße an euch beide
mfg STeve
Anzeige
Danke für Deine Wertschätzung, STeve ...
07.01.2018 21:45:57
Matthias
Hallo STeve,
Danke für Deine Wertschätzung,
allerdings komme ich heute wahrscheinlich nicht mehr dazu
es mit seinen neuen Angaben zu realisieren.
Ich schau sicher morgen wieder rein.
Gruß Matthias
AW: mit mir wolltest Du gestern nicht mehr "reden"?
07.01.2018 20:53:52
Maximus
Hi, ich habe mal einen ScreenShot angehängt, damit man es sich besser vorstellen:
Also ich habe drei Tabellen:
1. A3:I9 (keine Sperre notwendig)
2. A13:C15
3. E13:G20
Bevor die Sperre in Kraft treten soll,muss ich ein X in A13 und E13 setzen können.
In B13 und F13 sollte eine Sperre sein, die erst aufgelöst wird, wenn entweder der Eintrag aus D24 oder E24 entfernt wird. Also solange ein Eintrag in D24 UND E24 = SPERRE. Wenn noch wonders in der Tabelle eine Sperre ist, ist das auch ok, aber nicht notwendig.
siehe Anhang
Userbild
Anzeige
also heute hab ich keine Zeit mehr, Sorry ...owT
07.01.2018 21:48:28
Matthias
...denke mal für Tabelle 2 - so richtig
07.01.2018 23:11:26
STeve
Hallo Maximus...
...ich nehme an du wolltest A3:I3 angeben.(und nicht A3:I9)...
.....das müsste zumindest mal für die Tabelle 2 perfekt sein.
mfg an dich und Matthias L.
STeve
Wie von Matthias gemacht in "Diese Arbeitsmappe":
Option Explicit
Private Sub Workbook_Open()
Tabelle1.Protect "0000", UserInterfaceOnly:=True
End Sub

....in die Tabelle 2:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("A3:I3,A13:C15,E13:G20"), Target) Is Nothing Then
If Application.WorksheetFunction.CountA(Range("D24:E24")) = 2 Then GoTo sindbefuellt
Target.Value = IIf(Target.Value = "x", "", "x")
Cancel = True
Exit Sub
sindbefuellt:
If Target.Address = "$A$13" Then Exit Sub
If Target.Address = "$E$13" Then Exit Sub
Target.Value = IIf(Target.Value = "x", "", "x")
Cancel = True
End If
End Sub

...und so für Tabelle 3 richtig
08.01.2018 00:47:59
STeve
....in die Tabelle 3:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("A3:I3,A13:C15,E13:G20"), Target) Is Nothing Then
If Application.WorksheetFunction.CountA(Range("D24:E24")) = 2 Then GoTo sindbefuellt
Target.Value = IIf(Target.Value = "x", "", "x")
Cancel = True
Exit Sub
sindbefuellt:
If Target.Address = "$B$13" Then Exit Sub
If Target.Address = "$F$13" Then Exit Sub
Target.Value = IIf(Target.Value = "x", "", "x")
Cancel = True
End If
End Sub

AW: ...und so für Tabelle 3 richtig
08.01.2018 08:42:14
Maximus
Hallo Steve,
A3:I9 ist schon richtig.
Genau das ist es, was als Bedingung rauskommen sollte, dass B13 und F13 solange gesperrt sind, bis entweder D24 oder E24 entfernt worden sind. Das ist mit deinem Programm perfekt umgestzt wurden.
Vielen Dank funktioniert einwandfrei.
Habe das Programm in der Tabelle eingefügt.
Dieses Teilprogramm habe ich nicht eingefügt:
Option Explicit
Private Sub Workbook_Open()
Tabelle1.Protect "0000", UserInterfaceOnly:=True
End Sub
Wozu brauche ich das?
Funktioniert bei mir auch ohne.
Vielen Dank nochmal! I´m happy!
Super wenns klappt. DANKE f. Rückmeldung. owT
08.01.2018 19:40:48
STeve
.
hab doch noch mal geschaut ...
07.01.2018 22:45:04
Matthias
Hallo
Hab nun nochmal gelesen.

  • Entferne doch dem Blattschutz

  • Entferne den Zellschutz der relevanten Zellen.

  • Speichere die Datei

  • Öffne die Datei erneut


Nun ist der Blattschutz wieder gesetzt und die relvanten Zellen haben keinen Blattschutz mehr.
Gruß Matthias
AW: hab doch noch mal geschaut ...
08.01.2018 08:44:43
Maximus
Danke Matthias, werde ich testen!
Gruss
AW: hab doch noch mal geschaut ...
08.01.2018 09:00:44
Maximus
Vielen Dank nochmal Matthias für deine Beispieldatei! Hat mir super weitergeholfen!
Steve hat mir auch nochmal mit einer Ergänzung geholfen, womit die Bedingungen, die ich gerne im Vordruck haben wollte, perfekt umgesetzt wurden.
Viele Grüße aus Hamburg!
Markus

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige