Tabellenkalkulation

Hilfe bei einem Makro

Diskussionsgruppen
Betriebsysteme: Windows 7; WindowsVista; WindowsXP; Linux; BS-Sonstige
Software: Textverarbeitung; Tabellenkalkulation; Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; E-Mail/Outlook; Internet Browser; SW-Sonstige
Hardware: Mainboard/CPU/RAM; Grafikkarten; Peripherie; HW Sonstiges
Netzwerk: DSL; W-Lan; Telekommunikation; NW-Sonstiges
Programmierung: Skripte(PHP,ASP,Perl...); Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke

Frage

Hallo an alle und erst mal schöne Weihnachten, ich habe hier vor einiger Zeit ein Makro bekommen das bis jetzt einwandfrei funktioniert hat. Ich habe diese Datei sehr lange nicht mehr genutzt. Erstellt wurde die Datei im Excel 2000 und unter Windows NT jetzt benutze ich Excel 2002 unter Windows XP, ich weiß zwar nicht ob das was was mit Versions wechsel zu tun hat vielleicht könnt ihr mir ja weiter helfen. Das Makro verändert automatisch die Farbe von Buchstaben hat es zumindets gemacht !? Jetzt kommt folgende Fehlermeldung: Laufzeitfelher 1004 Die Color Index-Eigenschaft des Font-Objektes kann nicht festgelegt werden. Hier das Makro: Private Sub Worksheet_Change(ByVal Target As Excel.Range) Select Case Target.Value Case "K" Target.Font.ColorIndex = 3 Case "N" Target.Font.ColorIndex = 3 Case "O" Target.Font.ColorIndex = 3 Case "MS" Target.Font.ColorIndex = 3 Case "U" Target.Font.ColorIndex = 10 Case "SU" Target.Font.ColorIndex = 10 Case Else Target.Font.ColorIndex = xlColorIndexAutomatic End Select End Sub Ich hoffe ihr könnt mir da helfen . Gruß Michael

Antwort 1 von rainberg

Hallo Michael,

Dir ebenfalls Frohe Weihnacht.

Warum der Code bei Dir eine Fehlermeldung auslöst, kann ich leider nicht sagen, bei mir läuft er.

Der Code lässt sich aber wie folgt kürzen, versuch's mal damit.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Select Case Target.Value
    Case "K", "N", "O", "MS"
        Target.Font.ColorIndex = 3
    Case "U", "SU"
        Target.Font.ColorIndex = 10
    Case Else
        Target.Font.ColorIndex = xlColorIndexAutomatic
    End Select
End Sub

Gruß
Rainer

Antwort 2 von nighty

hi all

eventuelle geschuetzte bereiche wie verbundene zellen und oder bezugsverlust,letzteres liesse sich duch direkte sheet angaben beseitigen bzw durch Sheet(2).Activate statt der 2 bzw index liesse sich auch der name eintragen

Dann wuensche ich allen usern noch ein schoenes besinnliches Weihnachtfest :-))

gruss nighty

Antwort 3 von nighty

hi all

so attock wuerde ich sagen das ein bezugsverlust stattfand und letzteres das gewollte problem beheben koennte :-)

gruss nighty

Antwort 4 von nighty

hi all

eine moegliche loesung waere diese

gruss nighty

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Worksheets(1)
Select Case .Cells(Target.Row, Target.Column).Value
Case "K"
.Target.Font.ColorIndex = 3
Case "N"
.Target.Font.ColorIndex = 3
Case "O"
.Target.Font.ColorIndex = 3
Case "MS"
.Target.Font.ColorIndex = 3
Case "U"
.Target.Font.ColorIndex = 10
Case "SU"
.Target.Font.ColorIndex = 10
Case Else
.Cells(Target.Row, Target.Column).Font.ColorIndex = xlColorIndexAutomatic
End Select
End With
End Sub

Antwort 5 von nighty

hi all

dann noch rainer's optimierter code

gruss nighty

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    With Worksheets(1)
        Select Case .Cells(Target.Row, Target.Column).Value
        Case "K", "N", "O", "MS"
            .Target.Font.ColorIndex = 3
        Case "U", "SU"
            .Target.Font.ColorIndex = 10
        Case Else
            .Cells(Target.Row, Target.Column).Font.ColorIndex = xlColorIndexAutomatic
        End Select
    End With
End Sub

Antwort 6 von nighty

hi all

noch eine erklaerung :-)

gruss nighty ^^

ein tabellenereignis das keine worksheet angaben besitzt, verliert durch eine beliebige art der worksheetactivierung bzw selectierung (wie auch workbooks)dessen sogenannten focus bzw bezug zur eigentlich gedachten tabelle

p.s.
wusstet ihr schon das ich fuer erklaerungen oder auch beschreibungen meist laenger brauch als fuer den code *grummel*
fortsetzung
*§$*?()/&%*
:-))

Antwort 7 von Michael10

Hallo Rainer hallo Nighty,

danke erst mal für die Hilfe, ich habe es mit beiden Codes versucht aber die Fehlermeldung ist die gleiche geblieben.
Früher lief der Code einwandfrei, ihr seid sicher das es nicht mit der Versionsänderung von Excel zu tun hat ?
Ich hoffe ihr oder wer anders hat noch eine Idee.

Gruß Michael

Antwort 8 von nighty

hi all

und wenn du das zum anfang setzt ?

gruss nighty

Worksheets(1).Activate

Antwort 9 von Michael10

Hallo Nigthy,

ich habe jetzt mal deinen Code von Antwort Nr.4 in eine lehre Datei getan und da kommt jetzt eine andere Fehlermeldung und zwar:Laufzeitfehler 438
Objekt unterstütz diese Eigenschaft oder Methode nicht

Vielleicht hast du ja noch eine Idee.

Gruß Michael

Antwort 10 von fedjo

Hallo Michael10

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Worksheets(1)
Select Case .Cells(Target.Row, Target.Column).Value
Case "K"
Target.Font.ColorIndex = 3
Case "N"
Target.Font.ColorIndex = 3
Case "O"
Target.Font.ColorIndex = 3
Case "MS"
Target.Font.ColorIndex = 3
Case "U"
Target.Font.ColorIndex = 10
Case "SU"
Target.Font.ColorIndex = 10
Case Else
Cells(Target.Row, Target.Column).Font.ColorIndex = xlColorIndexAutomatic
End Select
End With
End Sub

Gruß
fedjo

Antwort 11 von Michael10

Hallo Fedjo,

ich habe deinen Code ins Tabellenblatt einfügt es kommt zwar keine Fehlermeldung beim schreiben der jeweiligen Buchstaben aber die Farbe verändert sich auch nicht !!??

Gruß Michael

Antwort 12 von fedjo

Hallo Michael,
bei mir funktioniert der Code.
Den Code in Tabelle1 einfügen.

Gruß
fedjo

Antwort 13 von Michael10

Hallo Fedjo,

ich habe Code schon richtig eingefügt passiert aber nichts ?!.
Keine Fehlermeldung keine Farbänderung.
Hat hier wer noch eine Idee.

Gruß Michael

Antwort 14 von fedjo

Hallo Michael,
ich mal eine Mustertabelle erstellt, die du ja mal testen kannst.

Gruß
fedjo

Antwort 15 von rainberg

Hallo Michael

versuch mal

With Worksheets("Tabellexyz")

anstatt

With Worksheets(1)

Tabellexyz natürlich anpassen.

Gruß
Rainer

Antwort 16 von Michael10

Hallo Fedjo hallo Rainer

Fedjo deine Musterdatei kann nicht angezeigt werden!

Rainer ich habe den Code so verändert ich hoffe das stimmt so

With Worksheets("Tabelle4")

bringt aber wieder die Fehlermeldung
Laufzeitfehler 438
Objekt unterstütz diese Eigenschaft oder Methode nicht

Ich hoffe euch vergeht nicht die Lust und ihr habt noch ein paar Ideen.

Gruß Michael

Antwort 17 von fedjo

Hallo Michael,

Mustertabelle

Gruß
fedjo

Antwort 18 von Michael10

Hallo Fedjo,

in der Mustertabelle funzt der Code nur wenn ich ihn in meiner Datei in die Tabelle einfüge kommt wieder die Fehlermeldung

Laufzeitfelher 1004
Die Color Index-Eigenschaft des Font-Objektes kann nicht festgelegt werden.

Ich habe nach einigen Suchen die Orginaldatei die hier zu diesen Thema bekommen gefunden da funzt auch alles wie gehabt.
Ich denke das Problem hängt mit der Datei zusammen aber was könnte das sein.

Gruß Michael

Antwort 19 von fedjo

Hallo Michael,
vielleicht solltest du deine Datei mal mit RapidShare ins
Forum stellen!

Gruß
fedjo

Antwort 20 von Michael10

Hallo Fedjo,

diese Datei ist ein Dienstplan ich habe für diesen Zweg die Namen raus genommen, der Farbcode befindet sich in den Manatsseiten von Januar bis Dezember.

Ich hoffe ihr du findet das Problem

http://rapidshare.com/files/176899464/Dienstplan-ohne_Namen.xls

So wie du habe ich das nicht hin bekommen aber das ist die Adreese wo die Datei steht.

Gruß Michael

Antwort 21 von Michael10

Hallo nochmal,

ich hoffe ich hab nichts falsch gemacht oder genießt ihr erst mal das schöne Wetter.
Ich hoffe bis dann.

Gruß Michael

Antwort 22 von fedjo

Hallo Michael,
bei mir funktioniert deine Datei.
Ich benutze auch XP und Excel 2000, es liegt dann vielleicht an Excel 2003. Welche Zeile im Code als Fehler (Debuggen) gelb angezeigt.

Gruß
fedjo

Antwort 23 von Michael10

Hallo Fedjo,

wenn ich ein N eingebe z.B.

Case "N"
Target.Font.ColorIndex = 3 < wird das gelb mit einem Pfeil
gekennzeicht wenn ich dann durch schliesen von VBA die Debbungen beende und das N aus der Zelle wieder lösche wir
das gelb angezeigt
Case Else
Target.Font.ColorIndex = xlColorIndexAutomatic

Gruß Michael

Antwort 24 von fedjo

Hallo Michael,
versuch es mal mit einer einfachen "If Abfrage".
Code in den Monaten ersetzen:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target = "K" Or Target = "N" Or Target = "O" Or Target = "MS" Then Target.Font.ColorIndex = 3
If Target = "U" Or Target = "SU" Then Target.Font.ColorIndex = 10
End Sub

Gruß
fedjo

Antwort 25 von Michael10

Hallo Fedjo,

gleicher Fehler bei der Eingabe von K wird das jetzt gelb

Target.Font.ColorIndex = 3

Bitte nicht aufgeben auch wenns heute nichts mehr wird.

Gruß Michael

Antwort 26 von fedjo

Hallo Michael,
zeichne doch mal in einer leeren Datei ein Makro auf, in dem die Schriftfarbe geändert wird und stell das Makro ins Forum.

Gruß
fedjo

Antwort 27 von Michael10

Hallo Fedjo,

wie gewünscht das aufgezeichnete Makro.

Sub Schriftfarbe_ändern()
'' Schriftfarbe_ändern Makro
' Makro am 26.12.2008
Range("A1:A10").Select
Selection.Font.ColorIndex = 3
End Sub

Ich hoffe das bringt dich weiter.

Muß jetzt leider erst mal weg.

Danke bis hier.

Ich hoffe bis später

Gruß Michael

Antwort 28 von fedjo

Hallo Michael,
versuchs mal so:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = "K" Or Target = "N" Or Target = "O" Or Target = "MS" Then Target.Font.ColorIndex = 3
If Target = "U" Or Target = "SU" Then Target.Font.ColorIndex = 10
End Sub

Gruß
fedjo

Antwort 29 von Michael10

Hallo Fedjo,

gleicher Fehler bei der Eingabe von K wird das jetzt gelb

Target.Font.ColorIndex = 3

Muß jetzt aber wirklich, bis dann.

Gruß Michael

Antwort 30 von fedjo

Hallo Michael,
und noch ein Versuch.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target = "K" Or Target = "N" Or Target = "O" Or Target = "MS" Then
Target.Font.ColorIndex = 3
End If
If Target = "U" Or Target = "SU" Then
Target.Font.ColorIndex = 10
End If
End Sub

Gruß
fedjo

Antwort 31 von fedjo

Hallo Michael,
habe den Code noch mal umgestellt.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target
Case "K", "N", "O", "MS"
Cells(Target.Row, Target.Column).Font.ColorIndex = 3
Case "U", "SU"
Cells(Target.Row, Target.Column).Font.ColorIndex = 10
Case Else
Target.Interior.ColorIndex = 0
End Select
End Sub

Gruß
fedjo

Antwort 32 von Hajo_Zi

Hallo,

nur kleine Verbesserung
für
End If
If Target ...
kann man auch schreiben
ElseIf Target ...

Gruß Hajo

Antwort 33 von Michael10

Hallo fedjo hallo Hajo,

ich habe beide Codes ausprobiert sie bringen beide die bekannte Fehlermeldung.
Da die Datei bei dir Fedjo unter Excel2000 läuft bei mir unter Excel 2003 nicht läuft aber das Orginal Makro in einer lehren Datei auch bei mir läuft hege den Verdacht das Excel 2003 etwas in der Datei verändert und das es garnichts mit VBA zu tun.
Aber was könnte das sein, ich hoffe es kommen noch ein Paar Ideen.

Gruß Michael

Antwort 34 von Hajo_Zi

Hallo,

ich hatte den Beitrag schon mal geschrieben, aber er ist nicht da.
kleine Verbesserung für
End If
If Target ...
kann man auch
ElseIf Target ...
Schreiben

Gruß Hajo

Antwort 35 von Hajo_Zi

Hallo Michael,

lade doch mal die Datei hoch. z.B. hier http://www.uploadagent.de/index.php
Link am Ende in den Beitrag kopieren.

Gruß Hajo

Antwort 36 von Michael10

Hallo Fedjo und Hajo und an alle die sich hier beteiligt haben,

ich habe den Fehler gefunden im Grunde ganz einfach man muß nur drauf kommen.
Die Seiten in meiner Datei sind alle Schreigeschütz weil da Menschen mit arbeiten die wenig Ahnung von Excel haben, nun hat Excel 2003 viel mehr Obtionen beim Schreibschutz wie Excel 2000, nun was mache ich wenn ich die Schriftfarbe in einer Zelle ändere ich formatiere sie, ich habe nun einfach beim setzen des Schreibschutzes noch erlaubt das der Nutzer Zellen Formatieren kann und schon lief das Orginal Makro wieder.

Ich bedanke mich bei allen hier geholfen haben und wünsche dem ganzen Forum einen guten Rutsch ins neue Jahr.

Gruß Michael