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 :-)