Hallo zusammen
Ich habe ein (hoffentlich) kleines Problem.
In meiner Tabelle mit Namen möchte ich per Tastendruck (ZB. Strg+Y)die Schriftfare ändern, aber nicht alle gleichzeitig sondern im abstand von sagen wir 5 Sekunden und das von unten nach oben. Ist das irgendwie machbar?
Vielen dank schon mal
Lg Stev
In meiner Tabelle mit Namen möchte ich per Tastendruck (ZB.
Strg+Y)die Schriftfare ändern, aber nicht alle gleichzeitig
sondern im abstand von sagen wir 5 Sekunden und das von unten
nach oben. Ist das irgendwie machbar?
Hallo Stev,
Alt+F11, Einfügen–Modul, Codes reinkopieren, Editor schließen.
In Excel Alt+F8, das Makro „Ein“ ausführen lassen.
Um Strg+y wieder in Standard zu versetzen, das Makro „Aus“ ausführen.
Gruß
Reinhard
Option Explicit
Sub BunteSchrift()
Dim Zei As Long
For Zei = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
Cells(Zei, 1).Font.ColorIndex = Int(Rnd() \* 56 + 1)
Application.Wait (Now + TimeValue("0:00:05"))
Next Zei
End Sub
Sub Ein()
Application.OnKey "^y", "BunteSchrift"
End Sub
Sub Aus()
Application.OnKey "^y"
End Sub
Hallo Reinhard
Danke für deine Mühe
Werde es gleich ausprobieren.
Gruß Stev
Hallo Reinhard
Es funktioniert einwandfrei
Kann ich die funktion auf weitere zellen erweitern weil hinter den Namen noch eineige zahlen sind die sich auch ändern sollen, und nur in der Farbe schwarz da ich verschiedene hintergrundfarben habe.
Vielan dank nochmal
(entschuldigung habe mich vieleicht forhin falsch ausgedrückt)
Gruß Stev
Hallo Stev,
Kann ich die funktion auf weitere zellen erweitern
ja, auf welche, stehen die fest oder müssen die ermittelt werden?
weil
hinter den Namen noch eineige zahlen sind die sich auch ändern
sollen, und nur in der Farbe schwarz da ich verschiedene
hintergrundfarben habe.
Verstehe ich nicht, du hast verwschiedene Hintergrundfarben und nun soll Vba die Schriftfarbe ändern aber nur in Schwarz!?
Wie wäre es mit einer Beispielmappe, Namen kannste ja ruckzuck anonymisieren, schreib oben in die oberste Namenszelle namen1, dann klickst du auf die rechte untere Ecke der Zelle und ziehst das nacht unten, das Gleiche mit Vorname1 usw.
Hochladen mit file-upload. s. FAQ:2606
Gruß
Reinhard
Hallo Reinhard
Ich habe die Beispielmappe hochgeladen.
Die Schriftfarbe ist der Hintergrundfarbe angepasst.
Wenn sich die Schriftfarbe in schwarzändert wird alles sichtbar.
Gruß Stev
Hallo Reinhard
Ich möchte aber diese funktion auch in anderen arbeitsblättern einsetzen die atwas anderes ausschauen.
ich glaub es wäre sinnfoll die Funktion auf das ganze Blatt auszuweiten.
Gruß Stev.
Ich möchte aber diese funktion auch in anderen
arbeitsblättern einsetzen die atwas anderes ausschauen.ich glaub es wäre sinnfoll die Funktion auf das ganze Blatt
auszuweiten.
Hallo Stev,
okay, lass uns das aber erstmal an Tabelle1 sauber zum Laufen bringen.
Die nachfolgenden Codes gehören in zwei Module.
Einmal das Modul „DieseArbeitsmappe“, einmal ein Satndardmodul Modul1", Modul2" o.ä.
Wenn du ein neues oder überhaupt ein Standardmodul haben willst, Einfügen—Modul im Editor.
Den Editor erreichst du mit Alt+F11.
Innerhalb des Editors wechselst du von Modul zu Modul mit Doppelklick auf den Modulnamen, die stehen so mit Pluszeichen usw. wie im Explorer links unter deinem Projekt, das Projekt erkennst du am Mappennamen.
Mit der Prozedur/Makro „Ein“ legst du ein Makro auf Tastenkombi Strg+y, mit Prozedur „Aus“ ist wieder Strg+y wie immer, ups, glaub das schrieb ich schonmal 
Manull kannst du eine Prozedur starten, wie z.B. „Ein“, indem du dich mit dem Curser mitten in deren Codezeilen stellst, dann F5 drückst, mach das mal.
Dann wechselst du mit Alt+F11 wieder zu Excel, dort dann Strg+y und beobachte was sich tut.
Willst du zum Testen die Schrift wieder verbergen, starte im Editor mit F5 die Prozedur „SchriftVerstecken“
In der Prozedur „Bunt“ siehst du die Codezeile
Sleep 178
Die Zahl ist die Wartezeit in Millisekunden, 5000 ms waren mir zu lang beim Testen , Kannst da ja verschiedene Werte austesten.
Gruß
Reinhard
in MOdul „dieseArbeitsmappe“
Option Explicit
Private Sub Workbook\_BeforeClose(Cancel As Boolean)
Call Aus
Call SchriftVerstecken
End Sub
Private Sub Workbook\_Open()
Call Ein
End Sub
in MOdul1
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub BunteSchrift()
Dim Zei As Long
With Worksheets("Tabelle1")
Zei = .Cells(Rows.Count, 9).End(xlUp).Row
If Zei \> 4 Then Call Bunt(Zei, 9)
Zei = .Cells(Rows.Count, 1).End(xlUp).Row
If Zei \> 4 Then Call Bunt(Zei, 1)
End With
End Sub
Sub Bunt(Zei As Long, Spa As Integer)
Dim Z As Long
With Worksheets("Tabelle1")
For Z = .Cells(Rows.Count, Spa).End(xlUp).Row To 5 Step -1
.Cells(Z, Spa).Resize(1, 8).Font.ColorIndex = 0
Beep
Sleep 178
DoEvents
Next Z
End With
End Sub
Sub SchriftVerstecken()
Dim Zelle As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
For Each Zelle In .Range("A5:stuck\_out\_tongue:28")
Zelle.Font.ColorIndex = IIf(Zelle.Interior.ColorIndex = -4142, 2, Zelle.Interior.ColorIndex)
Next Zelle
End With
Application.ScreenUpdating = True
End Sub
Sub Ein()
Application.OnKey "^y", "BunteSchrift"
End Sub
Sub Aus()
Application.OnKey "^y"
End Sub
Neuer Code
Hallo Stev,
ersetze mal alles in Modul1 durch den nachfolgenden Code. Achja, im Blatt, markiere Zeile 5, dann Ansicht—Fenster fixieren, dann sind die obertsen vier Zeilen fixiert, ist besser bei langen Tabellen.
Gruß
Reinhard
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub BunteSchrift()
Dim Zei As Long
Call SchriftVerstecken
With Worksheets("Tabelle1")
Zei = .Cells(Rows.Count, 9).End(xlUp).Row
If Zei \> 4 Then Call Bunt(Zei, 9)
Zei = .Cells(Rows.Count, 1).End(xlUp).Row
If Zei \> 4 Then Call Bunt(Zei, 1)
Application.Goto Reference:=.Cells(1, 1), scroll:=True
End With
End Sub
Sub Bunt(Zei As Long, Spa As Integer)
Dim Z As Long, Pos As Long
With Worksheets("Tabelle1")
Pos = 10
For Z = .Cells(Rows.Count, Spa).End(xlUp).Row To 5 Step -1
Application.Goto Reference:=.Cells(Pos, 1), scroll:=True
.Cells(Z, Spa).Resize(1, 8).Font.ColorIndex = 0
Beep
If Pos \> 5 Then Pos = Pos - 1
Sleep 178
DoEvents
Next Z
End With
End Sub
Sub SchriftVerstecken()
Dim Zelle As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
For Each Zelle In .Range("A5:stuck\_out\_tongue:28")
Zelle.Font.ColorIndex = IIf(Zelle.Interior.ColorIndex = -4142, 2, Zelle.Interior.ColorIndex)
Next Zelle
End With
Application.ScreenUpdating = True
End Sub
Sub Ein()
Application.OnKey "^y", "BunteSchrift"
End Sub
Sub Aus()
Application.OnKey "^y"
End Sub
Hallo Reinhard
Erstmals danke für deine Mühe
Der codes funktioniert einwandfrei nur das ergebniss ist nicht das was ich meine.
Die namen in der tabelle sind paarungen für ein Turnier, so spielt zum beispiel name 24 gegen name 48 usw. während des Turnieres werde die Paarungen auf großleinwand bekannt gegeben. Also macht es wenig Sinn wenn ich zuerst eine ganze spalte mit namen bekanntgebe und danach die spalte mit gegnern, sondern eher zeile für zeile von unten nach oben. da ich aber noch nicht weiß wieviel teilnehmer dabei sein werden, aber erfahrungsgemäs so etwa zwischen 50 und 60 wäre es gut wenn die funktion ab der zeile 60 starten würde und nacheinander die gesammte zeile für zeile die schriftfarbe in schwarz änderen würde.
Nochmals vielen dank
Gruß Stev
(Wissen ist Macht,nix wissen macht auch nix)
Der codes funktioniert einwandfrei nur das ergebniss ist
nicht das was ich meine.
sondern eher zeile für zeile von unten nach oben. da
ich aber noch nicht weiß wieviel teilnehmer dabei sein werden,
Hallo Stev,
okay, nochmal neuer Code, je nach Bildschirm und Schriftgröße die 18 variieren:
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub BunteSchrift()
Dim Z As Long, Pos As Long, Zei As Long
Call SchriftVerstecken
With Worksheets("Tabelle1")
Zei = .Cells(Rows.Count, 1).End(xlUp).Row
Pos = Zei - 18
For Z = Zei To 5 Step -1
Application.Goto Reference:=.Cells(Pos, 1), scroll:=True
.Cells(Z, 1).Resize(1, 16).Font.ColorIndex = 0
Beep
If Z = Pos Then Pos = Pos - 1
Sleep 178
DoEvents
Next Z
End With
End Sub
Sub SchriftVerstecken()
Dim Zelle As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
For Each Zelle In .Range("A5:stuck\_out\_tongue:28")
Zelle.Font.ColorIndex = IIf(Zelle.Interior.ColorIndex = -4142, 2, Zelle.Interior.ColorIndex)
Next Zelle
End With
Application.ScreenUpdating = True
End Sub
Sub Ein()
Application.OnKey "^y", "BunteSchrift"
End Sub
Sub Aus()
Application.OnKey "^y"
End Sub
Gruß
Reinhard
Hallo Reinhard
Genau so habe ich mir das vorgestellt
War ne schwere geburt, aber jetzt lebt das Kind:smile:
Allen respekt vor deinem wissen, aber noch mehr respekt vor deiner Geduld und vor deinem Zeitaufwand.
Danke nochmals und bis irgendwann mal wieder (mit sicherheit)
Ich werde dich in mein Abendgebet einschliesen.
Gruß Stev