Anzeige
Archiv - Navigation
304to308
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
304to308
304to308
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

offene Zellen färben - Auswahlbereich?

offene Zellen färben - Auswahlbereich?
04.09.2003 10:01:15
Tanja
Hallo Profis,

ich beziehe mich auf folgenden thread:

https://www.herber.de/forum/archiv/300to304/t302171.htm

habe aber eine weitere Fragestellung hierzu:

Wäre es möglich, wenn ja, wie, dem Anwender bei Anwendung dieses Makros eine Eingabebox zur Verfügung zu stellen, in welcher er einen Zellbereich festlegen kann, in welchem das Makro dann durchlaufen soll?
...das wäre sozusagen noch das Tüpfelchen auf dem i
*g*

Vielen Dank im Voraus für eure Hilfe!

Gruß
Tanja

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

Betreff
Datum
Anwender
Anzeige
AW: offene Zellen färben - Auswahlbereich?
04.09.2003 10:23:24
WernerB.
Hallo Tanja,

meinst Du sowas?

Sub MarkierenZellBereich()
Dim Bereich As Range
On Error Resume Next
Set Bereich = Application.InputBox("Bitte Bereich mit der Maus markieren", _
"Bereichswahl", , , , , , 8)
If Bereich Is Nothing Then
MsgBox "Nichts selektiert !" & vbCr & vbCr & "Makro-Abbruch !" _
, 0, "Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
On Error GoTo 0
Set Bereich = Nothing
End Sub

Viel Erfolg wünscht
WernerB.

P.S.: Das Forum lebt auch von den Rückmeldungen der Fragesteller (siehe dazu Forums-FAQ)!
Anzeige
AW: offene Zellen färben - Auswahlbereich?
04.09.2003 10:43:08
Tanja
Puuh! ...äh, also ich hab versucht, deinen Quelltext noch in das hier einzubauen:

(ursprünglich:)

Sub offeneZellenFärbenblau()
Dim RaZelle As Range
ActiveSheet.Unprotect
For Each RaZelle In ActiveSheet.UsedRange
If RaZelle.Locked = False Then RaZelle.Interior.ColorIndex = 5
' zurück
' If RaZelle.Locked = True Then RaZelle.Interior.ColorIndex = xlNone
Next RaZelle
End Sub



(verändert/kombiniert:)

Sub offeneZellenFärbenblau2()
'Dim RaZelle As Range
Dim Bereich As Range
On Error Resume Next
Set Bereich = Application.InputBox("Bitte Bereich mit der Maus markieren", _
"Bereichswahl", , , , , , 8)
If Bereich Is Nothing Then
MsgBox "Nichts selektiert !" & vbCr & vbCr & "Makro-Abbruch !" _
, 0, "Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
On Error GoTo 0
Set Bereich = Nothing
'ActiveSheet.Unprotect
For Each Bereich In ActiveSheet.UsedRange
If Bereich.Locked = False Then Bereich.Interior.ColorIndex = 5
' zurück
' If RaZelle.Locked = True Then RaZelle.Interior.ColorIndex = xlNone
Next Bereich
End Sub



...aber wie du wahrscheinlich umschwer feststellen kannst, hast du es hier mit einem VBA-Anfänger zu tun :o)
d. h. so krieg ich jetzt zwar diese Eingabebox rein, aber anschliessend werden doch auf dem gesamten Blatt die offenen Zellen eingefärbt...

Hilfe??!

Weisst du / irgendjemand weiter?

Grüßle
Tanja
Anzeige
AW: offene Zellen färben - Auswahlbereich?
04.09.2003 11:07:52
WernerB.
Hallo Tanja,

das sollte funktionieren (habe es aber nicht getestet):

Sub OffeneZellenFaerbenblau2()
Dim RaZelle As Range
Dim Bereich As Range
Application.ScreenUpdating = False
On Error Resume Next
Set Bereich = Application.InputBox("Bitte Bereich mit der Maus markieren", _
"Bereichswahl", , , , , , 8)
If Bereich Is Nothing Then
MsgBox "Nichts selektiert !" & vbCr & vbCr & "Makro-Abbruch !" _
, 0, "Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
On Error GoTo 0
'ActiveSheet.Unprotect
For Each RaZelle In Bereich
If RaZelle.Locked = False Then RaZelle.Interior.ColorIndex = 5
' zurück
' If RaZelle.Locked = True Then RaZelle.Interior.ColorIndex = xlNone
Next Bereich
Set Bereich = Nothing
Application.ScreenUpdating = True
End Sub

Gruß WernerB.
Anzeige
AW: offene Zellen färben - Auswahlbereich?
04.09.2003 11:21:00
Tanja
hi werner,

hab 'ne Kleinigkeit verändern müssen (unten)

soweit so gut...



Sub OffeneZellenFaerbenblau4()
Dim RaZelle As Range
Dim Bereich As Range
Application.ScreenUpdating = False
On Error Resume Next
Set Bereich = Application.InputBox("Bitte Bereich mit der Maus markieren", _
"Bereichswahl", , , , , , 8)
If Bereich Is Nothing Then
MsgBox "Nichts selektiert !" & vbCr & vbCr & "Makro-Abbruch !" _
, 0, "Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
On Error GoTo 0
'ActiveSheet.Unprotect
For Each RaZelle In Bereich
If RaZelle.Locked = False Then RaZelle.Interior.ColorIndex = 5
' zurück
' If RaZelle.Locked = True Then RaZelle.Interior.ColorIndex = xlNone
Next RaZelle '(Tanja) Bereich
Set Bereich = Nothing
Application.ScreenUpdating = True
End Sub



...aber...
...die komfortable Angabe des Bereiches mit der Maus geht so nicht mehr (aber die Angabe des Zellbereichs mit Hilfe der Tastatur) und komischerweise hab ich bei einem Versuch, in dem offene Zellen teilweise zuvor gelb gefärbt wurden, das Ergebnis, dass nicht alle offenen Zellen blau werden, sondern manche gelb bleiben...!?? *verwirrt*

Hast du 'ne Idee?

Grüßle - und dicken Dank schon mal für die bisherigen Antworten!
Tanja
Anzeige
AW: offene Zellen färben - Auswahlbereich?
04.09.2003 12:21:33
WernerB.
Hallo Tanja,

die komfortable Zellbereich-Selektion mit der Maus klappt jetzt wieder.
Der andere Fehler, dass nicht alle auf "ungeschützt" eingestellten Zellen blau eingefärbt werden, tritt bei mir nicht auf, ist also für mich nicht nachvollziehbar.

Sub OffeneZellenFaerbenblau5()
Dim RaZelle As Range
Dim Bereich As Range
On Error Resume Next
Set Bereich = Application.InputBox("Bitte Bereich mit der Maus markieren", _
"Bereichswahl", , , , , , 8)
If Bereich Is Nothing Then
MsgBox "Nichts selektiert !" & vbCr & vbCr & "Makro-Abbruch !" _
, 0, "Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
On Error GoTo 0
'ActiveSheet.Unprotect
Application.ScreenUpdating = False
For Each RaZelle In Bereich
If RaZelle.Locked = False Then RaZelle.Interior.ColorIndex = 5
' zurück
' If RaZelle.Locked = True Then RaZelle.Interior.ColorIndex = xlNone
Next RaZelle
Set Bereich = Nothing
Application.ScreenUpdating = True
End Sub

Gruß WernerB.
Anzeige
AW: funktioniert!- offene Zellen färben - Auswahl?
04.09.2003 12:35:55
Tanja
Hallo Werner,

is ja genial!
Also soweit funktioniert das jetzt prima!

Vielen dicken Dank :o))

Das Problem, das ich vorhin noch beschrieben hab, liegt daran, dass es sich dabei um ein bedingtes Format handelt - "dahinter" sind die Zellen tatsächlich blau...

...überlege gerade noch, ob es denn Sinn machen würde, das neue blau auch hier "darüber zu legen" bzw. die bedingte Formatierung zu löschen - glaub aber nicht...

Danke nochmal - so macht die Arbeit Spass!

Grüßle
Tanja
AW: offene Zellen färben - Auswahlbereich?
04.09.2003 10:59:15
Stephan
Hi Tanja!

Versuch mal den folgenden Code:


Sub Nicht_gesperrte_Zellen_färben()
'färbt alle nicht geperrten Zellen blau, falls leer, türkis falls
'etwas drinnen steht
Dim RaZelle As Range
Rangewahl:
selR = InputBox("Bitte Bereich im Format A1:X100 angeben", "Bereich auswählen")
If selR = "" Then Exit Sub
On Error GoTo errorhandler
Range(selR).Select
ActiveSheet.Unprotect
For Each RaZelle In Range(selR)
If RaZelle.Locked = False Then
RaZelle.Interior.ColorIndex = 34
RaZelle.FormatConditions.Delete
RaZelle.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="="""""
RaZelle.FormatConditions(1).Interior.ColorIndex = 35 'xlNone falls gefüllte Zellen weiß sein sollen
End If
' zurück
' If RaZelle.Locked = True Then RaZelle.Interior.ColorIndex = xlNone
Next RaZelle
ActiveSheet.Protect
Range("A1").Select
GoTo Ende
errorhandler:
MsgBox "Eingabebereich ist nicht korrekt!"
Resume Rangewahl
Ende:
End Sub



Gruß
Stephan
Anzeige
AW: offene Zellen färben - Auswahlbereich?
04.09.2003 11:23:11
Tanja
Hi Stephan,

eigentlich soll sich sonst nix verändern - egal ob in den Zellen was drin steht oder nicht - sondern nur alle (also auch ausserhalb x100) offenen Zellen eingefärbt werden...

...vielleicht hast du noch 'nen Tipp zu dem zweiten Lösungsansatz von Werner?

Vielen Dank trotzdem!
Tanja

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige