Seite 2 von 2 ErsteErste 1 2
Ergebnis 11 bis 18 von 18

Thema: Registerfarbe nach Bedingung per VBA verändern

  1. #11
    Office-Hilfe.com - Auskenner
    Registriert seit
    12.06.2014
    Beiträge
    183
    Genauso ist es

    Sehr geil vielen Dank

    Echt ein super Forum

  2. #12
    Office-Hilfe.com - Neuling
    Registriert seit
    10.07.2018
    Beiträge
    3
    Hallo,
    ich habe versucht den oberen String umzuwandeln damit das auf Jahre reagiert, aber irgendwie bin ich zu doof dafür!

    Ich habe eine Datei mit Register von 2001-2025 + Auswertungsregister und ich würde gerne beim öffnen mir wünschen, dass der Reiter mit dem Aktuellen Jahr Aktiv ist und sich grün einfärbt.

    Private Sub Workbook_Open()
    Dim arrJahre()
    Dim bytZaehler As Byte
    If Worksheets(Format(Date, "yyyy")).Tab.Color <> 40 Then
    arrJahre = Array("2001", "2002", "2003", "2004", "2005", "2005", "2006", "2007", "2008", "2009", "2010", "2011", "2012", "2013", "2014", "2015", "2016", "2017", "2018", "2019", "2020", "2021", "2022", "2023", "2024", "2025")
    For bytZaehler = 0 To 11
    If arrJahre(bytZaehler) = Format(Date, "YYYY") Then
    Worksheets(arrJahre(bytZaehler)).Tab.Color = 10
    Else
    Worksheets(arrJahre(bytZaehler)).Tab.ColorIndex = xlNone
    End If
    Next bytZaehler
    End If
    End Sub

    Da tut sich aber gar nichts......
    Danke vorab!

  3. #13
    Office-Hilfe.com - Legende
    Registriert seit
    26.08.2009
    Ort
    Bergstadt Freiberg/Sa.
    Beiträge
    2.713
    Hi,

    das kannst du so lösen:

    Code:
    Private Sub Workbook_Open()
        Dim wksTab As Worksheet
        For Each wksTab In Worksheets
            If IsNumeric(wksTab.Name) Then
                If CLng(wksTab.Name) = Year(Date) Then
                    wksTab.Tab.Color = 5287936
                    wksTab.Activate
                    Exit For
                Else
                    wksTab.Tab.ColorIndex = xlNone
                End If
            End If
        Next wksTab
    End Sub
    Bis später,
    Karin
    Standard: Win 10, Office 2016
    Bei Bedarf auch Excel 97 - 2013

  4. #14
    Office-Hilfe.com - Neuling
    Registriert seit
    10.07.2018
    Beiträge
    3
    Hey das funktioniert!!
    Vielen Dank!!

  5. #15
    Office-Hilfe.com - Neuling
    Registriert seit
    10.07.2018
    Beiträge
    3
    Hi Beverly (Karin)

    kann die Farbe auch geändert werden?? Also grün is ja nicht schlecht, nur aber mal zum Verständnis!
    Wenn ich den Wert 5287800 verändere ist immer noch die gleiche Farbe drin??
    Ebenso bei dieser Monats Funktion, da is der Aktuelle Monat schwarz!

    Grüßle,
    Thomas

  6. #16
    Office-Hilfe.com - Legende
    Registriert seit
    26.08.2009
    Ort
    Bergstadt Freiberg/Sa.
    Beiträge
    2.713
    Hi Thomas,

    wenn du eine bestimmte Farbe verwenden willst, formatiere einfach eine Zelle entsprechend - dann kannst du dir mit der Codezeile:

    Code:
    MsgBox ActiveCell.Interior.Color

    die betreffende Color-Nummer ausgeben lassen.


    Den Rest habe ich nicht verstanden - was meinst du mit "diese Monats Funktion"? In meinem Code gibt es keine, da wird nur das Jahr ausgelesen.

    Bis später,
    Karin
    Standard: Win 10, Office 2016
    Bei Bedarf auch Excel 97 - 2013

  7. #17
    Office-Hilfe.com - Profi
    Registriert seit
    24.11.2008
    Beiträge
    2.071
    Hallo @Beverly,
    Den Rest habe ich nicht verstanden - was meinst du mit "diese Monats Funktion"?
    auf Seite 1 von 2 in diesem Thread verwendete ich folgende monatsabhängige Call-Back-Funktion. Das darin enthaltene FOR-Statement (For I% = 1 To 12) dürfte wahrscheinlich auch die Ursache für die fehlerhafte Anwendung desselben auf Seite 2 (For bytZaehler = 0 To 11) gewesen sein.
    In diesem Makro unten verwendete ich 2 verschiedene Properties (.ColorIndex und .Color) mit den jeweils passenden Farbkonstanten, wobei die Konstante "vbGreen" den gleichen Wert liefert wie die Funktion "RGB(0,255,0)" nämlich 255*256 = 65280 = &H00FF00
    Die ColorIndex-Konstante "xlColorIndexNone" besitzt dagegen den dezimalen Wert -4142 (bzw. hexadez. &HEFD2).
    Vielleicht wurden beide vermischt verwendet, sodass sie nicht richtig funktionierten.

    Code:
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
      Dim Rg As Range
      Dim Monate As Variant, I%
      Monate = Array("", "Jan", "Feb", "Mrz", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")
      For I% = 1 To 12
        If Sh.Name = Monate(I%) Then
          'Blattname ist in der Monate-Liste enthalten -> Bereich B10:B40 prüfen
          Set Rg = Sh.Range("B10:B40").Find(What:=Date, LookIn:=xlValues, LookAt:=xlWhole)
          If Rg Is Nothing Then
            'Suchvorgang erfolglos:
            Sh.Tab.ColorIndex = xlColorIndexNone
          Else
            'HEUTE() wurde im Bereich B10:B40 gefunden -> BlattTab einfärben
            Sh.Tab.Color = vbGreen
          End If
          Exit Sub
        End If
      Next I
    End Sub
    Liebe Grüße
    Anton Exl

    Windows 10 (x64)
    Office 2016 Professional Plus

  8. #18
    Office-Hilfe.com - Auskenner
    Registriert seit
    29.12.2015
    Beiträge
    132
    Moin!
    Mal eine Ergänzung, wie man die Arrays bequemer füllen kann.
    Statt
    Code:
      Dim Monate As Variant
      Monate = Array("Jan", "Feb", "Mrz", "Apr", "Mai", "Jun", _
        "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")
    geht sehr viel einfacher:
    Code:
    Dim Monate As Variant
      Monate = Application.GetCustomListContents(7)
    Zu beachten ist jedoch, dass das erste Array Null- (For i = 0 To 11), das Zweite jedoch Eins-basiert (For i = 1 To 12) ist.

    Das Jahresarray
    Code:
    arrJahre = Array("2001", "2002", "2003", "2004", "2005", "2005", "2006", "2007", "2008", "2009", "2010", _
       "2011", "2012", "2013", "2014", "2015", "2016", "2017", "2018", "2019", "2020", _
       "2021", "2022", "2023", "2024", "2025")
    füllt man sehr viel einfacher mit
    Code:
    Dim arrJahre As Variant
      arrJahre = [row(2001:2025)]
    oder auch mit
    Code:
    Dim arrJahre As Variant
      arrJahre = Evaluate("row(2001:2025)")
    Beachte, dass hier ein zweidimensionales Array(1 To 25, 1 To 1) erzeugt wird!

    Gruß Ralf
    Geändert von RPP63 (15.07.2018 um 08:21 Uhr)

Berechtigungen

  • Neue Themen erstellen: Nein
  • Themen beantworten: Nein
  • Anhänge hochladen: Nein
  • Beiträge bearbeiten: Nein
  •  
Excel Ticker - News, Tipps und Tricks zu Microsoft Excel | SMS kostenlos versenden | Forenuser - Die Foren Findmaschine