Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1660to1664
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 Zelle/Zellen färben und ohne Formatierung

VBA Zelle/Zellen färben und ohne Formatierung
01.12.2018 01:12:12
Alex
Guten Abend liebe Excelexperten,
ich habe folgenden Code:
----------------------------------------------------------------------------------
If Intersect(Target, Range("E4:AI203, E205:AI303, E305:AI403, E405:AI503")) Is Nothing Then GoTo start
Dim wsh As Object
Dim net As Object
Dim username As String
Dim colorindex As Variant
Set net = CreateObject("WScript.Network")
username = net.username
If username = "" Then
Set wsh = CreateObject("WScript.Shell")
username = wsh.RegRead("HKEY_CURRENT_USER\Software\Microsoft\" _
& "Windows\CurrentVersion\Explorer\Logon User Name")
End If
Select Case username
Case "PC1": colorindex = 6
Target.Font.colorindex = 1
Target.Font.Bold = True
Case "PC2": colorindex = 5
Target.Font.colorindex = 2
Target.Font.Bold = True
Case Else: colorindex = xlNone
End Select
Select Case Target
Case "": colorindex = xlNone
Target.Interior.colorindex = colorindex
Target.Font.colorindex = 1
Target.Font.Bold = False
Exit Sub
End Select
Target.Interior.colorindex = colorindex
start:
--------------------------------------------------------------------------
Folgendes Problem tritt auf:
Wenn nur eine Zelle ausgewählt wird und ein Eintrag gemacht wird, dann wird die Zelle, wenn Sie einen Eintrag enthält demenstprechend gefärbt und wenn diese leer ist wieder entfärbt.
Das Problem welches ich habe ist, dass wenn mehrere Zellen markiert sind mir der Laufzeitfehler 13 als Resultat angezeigt wird.
Wie müsste der Code verändert werden, damit dieser auch bei einer Auswahl von mehrere Zellen funktioniert?
Ich danke schonmal :-)

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Zelle/Zellen färben und ohne Formatierung
01.12.2018 07:53:59
Hajo_Zi
mal den kompletten Code.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' F?llfarbe
' f?r Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range                          ' Variable f?r Bereich
Dim RaZelle As Range                            ' Variable f?r Zelle
' Bereich der Wirksamkeit
Set RaBereich = Range("E4:AI203, E205:AI303, E305:AI403, E405:AI503")
' noch mehr Bereiche
Set RaBereich = Intersect(RaBereich, Target)
If Not RaBereich Is Nothing Then
'ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In RaBereich
With RaZelle
Dim wsh As Object
Dim net As Object
Dim username As String
Dim colorindex As Variant
Set net = CreateObject("WScript.Network")
username = net.username
If username = "" Then
Set wsh = CreateObject("WScript.Shell")
username = wsh.RegRead("HKEY_CURRENT_USER\Software\Microsoft\" _
& "Windows\CurrentVersion\Explorer\Logon User Name")
End If
Select Case username
Case "PC1": colorindex = 6
RaZelle.Font.colorindex = 1
RaZelle.Font.Bold = True
Case "PC2": colorindex = 5
RaZelle.Font.colorindex = 2
RaZelle.Font.Bold = True
Case Else: colorindex = xlNone
End Select
Select Case RaZelle
Case "": colorindex = xlNone
RaZelle.Interior.colorindex = colorindex
RaZelle.Font.colorindex = 1
RaZelle.Font.Bold = False
Exit Sub
End Select
End With
Next RaZelle
End If
End Sub

Ich kann es nicht testen.

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.
Anzeige
AW: VBA Zelle/Zellen färben und ohne Formatierung
02.12.2018 01:23:30
Alex
Danke dir damit läufts :-)

325 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige