Pchełki VBA. Odcinek 18: gradienty

https://xpil.eu/avmhf 📋

W dzisiejszym odcinku pchełek pobawimy się kolorami. A konkretnie, spróbujemy pokolorować tła komórek w pojedynczym wierszu w taki sposób, żeby uzyskać efekt gradientowego przejścia między dwoma kolorami.

Od razu przypomnę, że możliwość nadawania gradientu w tle komórki istnieje w Excelu od dawna - jednak dotyczy ona wyłącznie pojedynczej komórki. Ja zaś spróbuję uzyskać ów gradient na wielu sąsiadujących ze sobą komórkach.

Najpierw, tradycyjnie, kod. Poniżej kodu - objaśnienie.

Option Explicit
Public Sub AddGradient(rngFrom As Excel.Range, rngTo As Excel.Range, _
                        colFrom As Long, colTo As Long)

    If rngFrom.Row <> rngTo.Row Then
        MsgBox "rngFrom and rngTo have to be in the same row!", vbOKOnly + vbCritical
        End
    End If

    If rngFrom.Column = rngTo.Column Then
        MsgBox "rngFrom and rngTo have to be in different columns!", vbOKOnly + vbCritical
        End
    End If

    rngFrom.Interior.Color = colFrom
    rngTo.Interior.Color = colTo

    Dim rng As Excel.Range
    Dim diffR As Double, diffG As Double, diffB As Double
    Dim R As Integer, G As Integer, B As Integer

    diffR = (colTo Mod 256 - colFrom Mod 256) / (rngTo.Column - rngFrom.Column)
    diffG = (((colTo \ 256) Mod 256 - (colFrom \ 256) Mod 256)) / (rngTo.Column - rngFrom.Column)
    diffB = (colTo \ 65536 - colFrom \ 65536) / (rngTo.Column - rngFrom.Column)

    Set rng = rngFrom.Offset(0, 1)

    Do While rng.Column < rngTo.Column
        R = colFrom Mod 256 + diffR * (rng.Column - rngFrom.Column)
        G = (colFrom \ 256) Mod 256 + diffG * (rng.Column - rngFrom.Column)
        B = colFrom \ 65536 + diffB * (rng.Column - rngFrom.Column)
        rng.Interior.Color = RGB(R, G, B)
        Set rng = rng.Offset(0, 1)
    Loop
End Sub

Objaśnienie kodu:

Option Explicit

Było już tłumaczone wielokrotnie, proszę sobie poszukać w poprzednich pchełkach.

Public Sub AddGradient(rngFrom As Excel.Range, rngTo As Excel.Range, _
colFrom As Long, colTo As Long)

Tworzymy procedurę o nazwie AddGradient, z czterema parametrami: rngFrom (komórka początkowa), rngTo (komórka końcowa), colFrom (kolor początkowy) oraz colTo (kolor końcowy).

If rngFrom.Row <> rngTo.Row Then
MsgBox "rngFrom and rngTo have to be in the same row!", vbOKOnly + vbCritical
End
End If

If rngFrom.Column = rngTo.Column Then
MsgBox "rngFrom and rngTo have to be in different columns!", vbOKOnly + vbCritical
End
End If

Powyższy kod sprawdza czy komórka początkowa i końcowa znajdują się w tym samym wierszu ale w różnych kolumnach. Jeżeli nie, wyświetlany jest komunikat błędu i procedura kończy pracę.

rngFrom.Interior.Color = colFrom
rngTo.Interior.Color = colTo

Te dwie linijki ustawiają kolor tła pierwszej komórki na colFrom oraz ostatniej komórki na colTo.

Dim rng As Excel.Range
Dim diffR As Double, diffG As Double, diffB As Double
Dim R As Integer, G As Integer, B As Integer

Tutaj deklarujemy kilka zmiennych. Po kolei:

rng: nasz "kursor" czyli obiekt klasy Excel.Range, którym będziemy przemieszczać się w poziomie, kolorując tła kolejnych komórek.

diffR, diffG, diffB: różnice w kolorze między dwiema sąsiednimi komórkami (trzy składowe: Red, Green i Blue). Typu Double (ułamkowe) żeby uniknąć błędów zaokrągleń przy większej ilości komórek.

R, G, B: na bieżąco wyliczane wartości gradientu bieżącej komórki (osobno dla każdej składowej Red, Green i Blue)

Set rng = rngFrom.Offset(0, 1)

Tutaj ustawiamy nasz wirtualny "kursor" na komórce po prawej stronie od komórki początkowej (której nie trzeba kolorować, bo jest już pokolorowana - patrz wyżej).

Do While rng.Column < rngTo.Column

Pętla Do...Loop ustawia kolor tła pod "kursorem", następnie przesuwa "kursor" w prawo o jedną komórkę. Wykonuje się dopóki, dopóty numer kolumny z "kursorem" jest mniejszy niż numer kolumny komórki końcowej.

R = colFrom Mod 256 + diffR * (rng.Column - rngFrom.Column)

Składowa R (czerwony) siedzi w trzech najmłodszych bitach RGB, stąd colFrom Mod 256 zwraca wartość tej składowej dla barwy początkowej, następnie dodajemy diffR (czyli krok składowej Red) przemnożone przez ilość kolumn między komórką pod "kursorem" (rng.Column) a komórką początkową (rngFrom.Column). A więc czym dalej od komórki początkowej, tym większy mnożnik.

G = (colFrom \ 256) Mod 256 + diffG * (rng.Column - rngFrom.Column)

Składowa G (zielony) siedzi w trzech "środkowych" bitach RGB, stąd trzeba najpierw przesunąć te bity w prawo o osiem pozycji (colFrom \ 256) a następnie "wyłuskać" składową G dzieląc przesuniętą wartość modulo 256 (dzięki temu odrzucamy starsze bity, czyli ewentualną składową niebieską). A potem dodajemy diffG przemnożone przez odległość od komórki startowej (podobnie jak dla diffR w poprzednim akapicie).

B = colFrom \ 65536 + diffB * (rng.Column - rngFrom.Column)

Składowa niebieska siedzi w trzech najstarszych bitach RGB, a więc przesuwamy o szesnaście bitów w prawo (2^16 = 65536), nie musimy już robić modulo 256 bo cztery najstarsze bity typu Integer będą tutaj zawsze wyzerowane. Potem mnożenie, identyczne jak w poprzednich przykładach.

rng.Interior.Color = RGB(R, G, B)
Set rng = rng.Offset(0, 1)

Ustawiamy kolor tła komórki pod "kursorem" na RGB(R, G, B), następnie przesuwamy "kursor" o jedną kolumnę w prawo.

Loop
End Sub

Koniec pętli, koniec procedury.

Można próbować pokusić się o "lepsze" gradienty, mianowicie indywidualnie sformatować tło każdej z zadanych komórek lokalnym gradientem (zamiast pojedynczym kolorem), dzięki czemu przejście kolorów będzie doskonale płynne nawet dla niewielkiej ilości kolorowanych komórek. Ale to już może innym razem.

Voila!

https://xpil.eu/avmhf 📋