Benötige Hilfe für eine bedingte Formatierung mit VBA

Question

Hallo Liebe Forumsmitglieder,
habe mir hier schon viel Hilfe im Forum holen können, aber dieses Mal komm ich irgendwie nicht weiter.
Ausgangslage
Tabellenblatt 1: (Planungsliste)
Übersicht aller Positionen von denen Tabellenblätter vorhanden sind, insgesamt 31 Zeilen. In Spalte S in der Übersicht Soll ein orangener Punkt angezeigt werden (Arial Schriftgröße: 100 Punkte, Farbe Orange) Wenn hinten im Tabellenblatt zur zugehörigen Zeile im DropDown Menü "Ja" ausgewählt wird. Soweit kein Problem über eine Wenn Funktion

=WENN(leer1!Y$7=2;"kein O-Punkt erteilt!";"•")

Jedoch wird mir nun wenn ich imDrop Down Menü "nein" auswähle, "kein O-Punkt erteilt!" auch in Orange und Schriftgröße 100 angezeigt, das soll aber in Schriftgröße 8 und in schwarz erfolgen.

Hier beginnt nun das eigentliche Problem.
Hat jemand ne Idee wie das Makro aussehen muss, damit ich das in Spalte S welche über das DropDown Menü automatisch befüllt wird, damit entweder der Punkt oder der Text richtig angezeigt wird? Wichtig: Die Spalte S ist auch über einen Blattschutz gegen Eingaben gesperrt.

Komme hier leider nicht weiter und es ist sehr dringend!

Vielen Dank im Voraus für Eure Hilfe

David

Answer 1

Hi,

Das muss irgendwie wie dem Tabellenschutz zusammen hängen. (Wieder was neues für mich.) Da ich das hier ohne .Protect habe laufen lassen, ist es mir nat. nicht aufgefallen. Jetzt mit dem Code (wie oben gepostet) im Calculate-Ereignis, bringe ich unter Umständen die ganze Mappe zum Stillstand. Nehmen wir also Activate-Ereignis der Tabelle. Nachteil dabei: Du wirst kurz die Tabelle, wenn Du auf sie wechselst, mit der "falschen" Formatierung sehen. malSchauen, ob Du damit dann so leben kannst.

Entferne allen bisher geposteten Code aus der Tabelle und füge folgenden ein:

Private Sub Worksheet_Activate()

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Dim rngZelle As Range

Me.Unprotect Password:="DeinPasswort" 'BlattSchutz aufheben
For Each rngZelle In Range("A1:A31") 'für jede Zelle im Bereich S1:S31
If rngZelle.Value = "•" Then 'wenn der Inhalt "•"
With rngZelle.Font 'mit den Schrifteigenschaften dieser Zelle
.ColorIndex = 44 'Farbe Orange
.name = "Arial" 'Schrift "Arial"
.Size = 100 'Größe 100
End With 'MIT-Ende
Else 'anderer Inhalt als ein "•"
With rngZelle.Font
.ColorIndex = xlAutomatic 'Farbe auf Auto (=1 wäre Schwarz)
.Size = 8 'Größe 8
.name = "Arial" 'Schrift "Arial
End With
End If
Next
Me.Protect Password:="DeinPasswort" 'Blattschutz einschalten

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

Etwas anderes will mir da leider nicht einfallen.

bye
malSchauen

Answer 2

Hall malSchauen,
das VBA ist perfekt. Jetzt passt wirklich alles.
Jedoch habe ich jetzt noch ne zweite Frage.

In meinen Eingabeblättern habe ja insgesamt 31 vergebe ich automatisch einen Namen für das Tabellenblatt über folgendes VBA, welches im Blatt steht, wenn man mit Rechtsklick auf den Reiter klickt:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "K2" Then Exit Sub

On Error Resume Next
Me.Name = Target.Value
If Err.Number <> 0 Then
MsgBox "Der Blatname '" & Target.Value & "' ist ungültig!", vbExclamation
End If
End Sub

Diesen Namen finde ich auch vorne auf meiner Liste wiederda er aus dem gleichen Feld "K2" verlinkt ist. Beim eingeben der Daten, habe ich nun das Problem, da es sich um Nummern und keine Namen habndelt, das die einzelnen Tabellenblätter nur noch schwer auffindbar sind.
Da habe ich gedacht, ich lege den Namen in der Liste einfach als Hyperlink an funktioniert auch gut, genau so lange bis sich hinten der Blattname ändert. Zum Beispiel von "Leer13" auf "A839-542" wer Name des Hyperlinks ändert sich zwar mit, jedoch fehlt der Bezug zum entsprechende Tabellenblatt.

Fehlermeldung: Bezug fehlt!

Kann man hier Abhilfe schaffen?

Wenn ja wie? Hast Du eine Idee?

Grüße David

Answer 3

Hi,

Da würde ich nicht mit Hyperlinks arbeiten wollen.

Zum einen würde ich das Makro aus A12 modifizieren wollen. Warum? Ich möchte sicherstellen, dass in K2 immer der jeweilige Blattname steht. Auch wenn direkt nach dem Bestätigen der MsgBox das Tel. klingelt. ;-) Dann kann es auch "Vorne"? in der Liste keinen Eintrag geben, der einen falschen Bezug darstellt. Mein Ansatz sieht dafür aus wie folgt:

If Target.Address(0, 0) = "K2" Then
On Error Resume Next
Me.name = Target.Value
If Err.Number <> 0 Then
MsgBox "Der Blattname '" & Target.Value & "' ist ungültig!", vbExclamation
Target.Value = ActiveSheet.name
Target.Activate
End If
End If

Dann würde ich die Hyperlinks löschen wollen, um im SelectionChange-Ereignis der Liste "vorne" folgenden Code zu platzieren:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range(Target.Address), Range("A1:A31")) Is Nothing _
And Target.Count = 1 Then
'um zweimal hintereinander das selbe Blatt wählen zu können
'Nachbarzelle selektieren
Range(Target.Address).Offset(0, 1).Select
ThisWorkbook.Sheets(CStr(Target.Value)).Select
End If
End Sub

Der Bereich muss nat. angepasst werden (hier A1:A31).
Wenn es denn Hyperlinks sein müssen, könnte man evtl. im SheetActivate-Ereignis die Links jeweils neu schreiben (wie oben bei der Formatiererei).

bye
malSchauen

Answer 4

Hallo malSchauen,
das funktioniert ja perfekt. Echt eine elitäre Lösung!!!

Vielen Dank und ein schönes Wochenende.

Grüße
David

Answer 5

Hallo malSchauen,
ich weiß es ist schon eine Weile her, jedoch bin ich fast am verzweifeln, wie muss Dein Code aussehen, damit ich die Planungsliste sortieren kann per Autofilter? Habe es versucht bekomme es nicht hin.

Private Sub Worksheet_Activate()

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Dim rngZelle As Range

Worksheets("Planungsliste").Protect Password:="test", userinterfaceonly:=True
For Each rngZelle In Range("R1:R37") 'für jede Zelle im Bereich R1:R37
If rngZelle.Value = "•" Then 'wenn der Inhalt "•"
With rngZelle.Font 'mit den Schrifteigenschaften dieser Zelle
.ColorIndex = 45 'Farbe Orange
.Name = "Arial" 'Schrift "Arial"
.Size = 100 'Größe 100
End With 'MIT-Ende
Else 'anderer Inhalt als ein "•"
With rngZelle.Font
.ColorIndex = xlAutomatic 'Farbe auf Auto (=1 wäre Schwarz)
.Size = 8 'Größe 8
.Name = "Arial" 'Schrift "Arial
End With
End If
Next
Worksheets("Planungsliste").Protect "test", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True


With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range(Target.Address), Range("c5:c37")) Is Nothing _
And Target.Count = 1 Then
'um zweimal hintereinander das selbe Blatt wählen zu können
'Nachbarzelle selektieren
Range(Target.Address).Offset(0, 1).Select
ThisWorkbook.Sheets(CStr(Target.Value)).Select
End If
End Sub

Kannst Du mir nochmal helfen?

Wenn ich Datei öffne, lässt sie sich noch sortieren, erst wenn ich auf ein anderes Tabellenblatt springe und wieder zurück auf die Planungsliste springe lässt sie sich nicht mehr sortieren. Autofilter und Zellformatierung funktionieren aber immer noch.

Was stimmt da nicht?

Vielen Dank im Voraus!

Grüße
David

Answer 6

Hi,

Ich kann Dir leider nicht ganz folgen, wo genau Dein Problem liegt. Reagiert etwas nicht? Gibt es Fehlermeldungen? Was soll wo, wann, wie sortiert werden? (eine BeispielDatei wäre in diesem Fall wohl das Beste)

So aus dem Stand gehe ich einmal davon aus, dass Du eine Fehlermeldung erhälst die besagt, dass Du geschützte Zellen ändern willst, was ohne Aufhebung des Schutzes so nicht möglich sei. Da Du die Tabelle("Planungsliste") im Makro ja mit eben diesem Schutz versiehst, liegt das für mich am nächsten. Da hilft auch der Parameter AllowSorting:=True nicht wirklich. So Du dazu in der Entwicklerhilfe nachliest findest Du folgendes:

Mit True können Benutzer für das geschützte Arbeitsblatt eine Sortierung vornehmen. Für jede Zelle im Sortierbereich muss die Sperre oder der Schutz aufgehoben werden. Der Standardwert ist False

Hebe doch spasseshalber den Tabellenschutz für "Planungsliste" auf, kommentiere in Deinem Makro die beiden Zeilen mit der .Protect-Methode aus. Hast Du dann immernoch das Problem?

bye
malSchauen