Efektivní přebarvení oblasti buněk

Berete do ruky svou pár let starou šablonu nebo sešit klienta, jehož barevná koncepce a štábní kultura pokulhává a chystáte se ho přebarvit? Tušíte, že to bude práce na dlouhé minuty, ne-li hodiny? Zkusím vám práci trochu zpříjemnit a především zkrátit.

Ergonomie novodobých Excelů s Pásem karet nám moc nepomáhá. Zatímco dříve bylo možné patřičné panely pro barvy a ohraničení možné odtrhnout a mít je k dispozici jako plovoucí dialogy na jedno klepnutí myši, dnes je především přístup k nástrojům ohraničení otravný. Přitom ruční kreslení ohraničení patřilo k neprávem opomíjeným technikám.

Panely pro práci s barvami a ohraničením v Excelu 2003 a 2010

S tímhle už dnes v Excelu prostě nepochodíte…

1
2
3
4
5
6
7
8

Sub Excel2003()

'panely Barva výplně, Barva písma a Ohraničení
Application.CommandBars("Fill Color").Visible = True
Application.CommandBars("Font Color").Visible = True
Application.CommandBars("Borders").Visible = True

End Sub

Můžete namítat, že Excel 2007 jako první přinesl rozšířenou paletou barev a lepší práci s motivy. Osobně to vidím spíš jako barevný povyk pro nic, který byl převzat z okrajově používaného Publisheru. Pro přebarvení nám nebude moc platná ani skupina Motivy na kartě Rozložení stránky, ani Styly na kartě Domů. Potřebujeme něco víc.

Je škoda, že uživatelé pořádně neznají možnosti dialogu Najít/Nahradit (CTRL+F, CTRL+H). Většina z nich nikdy neklepla myškou na tlačítko Možnosti…

Najít a nahradit - Formát — Najít a nahradit – Formát

Pozn. Dobrým zvykem je před uzavřením dialogu vymazat formátování (rozklepněte tlačítko Formát, volba Vymazat pole pro hledání formátu). Programové zpracování by mohlo vypadat nějak takto:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

Sub ZmenaBarevnostiPozadi()
With Application
'najít barvu pozadí buňky (červená)
.FindFormat.Interior.ColorIndex = 3
'zaměnit za barvu (fialová)
.ReplaceFormat.Interior.ColorIndex = 13
End With
'vlastní záměna pro výběr buněk
Selection.Replace What:="", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
ReplaceFormat:=True
'odstranění nastavení formátů pro vyhledávání
With Application
.FindFormat.Clear
.ReplaceFormat.Clear
End With
End Sub

Sub ZmenaBarevnostiOhraniceni()
With Application
'najít barvu ohraničení buňky (červená)
.FindFormat.Borders.ColorIndex = 3
'zaměnit za barvu (fialová)
.ReplaceFormat.Borders.ColorIndex = 13
End With
'vlastní záměna pro výběr buněk
Selection.Replace What:="", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
ReplaceFormat:=True
'odstranění nastavení formátů pro vyhledávání
With Application
.FindFormat.Clear
.ReplaceFormat.Clear
End With
End Sub

Výpis VBA výše ukazuje práci s vlastností ColorIndex, která je vlastní základní barevné paletě z Excelu 2003. Na sešity novodobých verzí Excelu doporučuji aplikovat vlastnost Color.

Pozor na jednu věc. Řekněme, že existuje zelené svislé ohraničení mezi sousedícími buňkami C7 a D7. Excelu není jedno, jestli k němu fyzicky došlo obarvením pravé hrany buňky C7 nebo levé hrany buňky D7, i když pro oko je výsledek stejný. Evidentní je tento rozdíl v případě, že v daném místě dojde k zalomení stránky. Ohraničení se pak zobrazí u té buňky, na které bylo skutečně užito.

Pořád to není ale to pravé ořechové, že? Co když chceme nahradit všechny výskyty červené barvy u všech typů ohraničení naráz? Jistě, máme tu VBA…

Následující proceduru jsem sestavil co nejuniverzálnější. Očekává, že uživatel vybere oblast pro záměnu barevnosti, následně referenční buňky s původními a novými barvami, a zeptá se ještě na typ objektu pro přebarvení (0 … vše, 1 … písmo, 2 … pozadí, 3 … ohraničení). Zde už pracuji s vlastností Color.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

Sub ZmenaBarevnosti()

Dim strRev As String
Dim rngBunka As Range
Dim rngRefOblast1 As Range
Dim rngRefOblast2 As Range
Dim iCil As Byte
Dim iPocetBarev As Integer
Dim aPoleBarvy()

On Error Resume Next

'oblast pro přebarvení
Set rngOblast = Application.InputBox("Vyberte oblast pro přebarvení.", _
"Zpracovávaná oblast", Selection.Address(0, 0), , , , , 8)
If Err <> 0 Then Exit Sub

'referenční buňka s původní (hledanou) barvou
Set rngRefOblast1 = _
Application.InputBox("Vyberte referenční buňky s původními barvami.", _
"Referenční oblast 1", Selection.Address(0, 0), , , , , 8)
If Err = 0 Then

iPocetBarev = rngRefOblast1.Cells.Count

ReDim aPoleBarvy(1 To iPocetBarev, 1 To iPocetBarev)

For i = 1 To iPocetBarev
'původní barvy
aPoleBarvy(i, 1) = rngRefOblast1.Cells(i).Interior.Color
Next i

Else
Exit Sub
End If

'referenční buňka s nově aplikovanou barvou
Set rngRefOblast2 = _
Application.InputBox("Vyberte referenční buňky s novými barvami.", _
"Referenční oblast 2", rngRefOblast1.Offset(0, 1).Address(0, 0), , , , , 8)
If Err = 0 Then

For i = 1 To iPocetBarev
'nové barvy
aPoleBarvy(i, 2) = rngRefOblast2.Cells(i).Interior.Color
Next i

Else
Exit Sub
End If

'cíl přebarvení (0 ... vše, 1 ... písmo, 2 ... pozadí, 3 ... ohraničení))
strRev = Application.InputBox(Title:="Cíl přebarvení", _
Prompt:="0 ... vše, 1 ... písmo, 2 ... pozadí, 3 ... ohraničení", _
Default:="0", Type:=2)

If strRev = "False" Then
Exit Sub
Else
iCil = Val(strRev)
End If

Application.ScreenUpdating = False

For i = 1 To iPocetBarev

For Each rngBunka In rngOblast.Cells

With rngBunka

If iCil = 1 Or iCil = 0 Then
If rngBunka.Font.Color = aPoleBarvy(i, 1) Then
'barva písma
rngBunka.Font.Color = aPoleBarvy(i, 2)
End If
End If

If iCil = 2 Or iCil = 0 Then
If rngBunka.Interior.Color = aPoleBarvy(i, 1) Then
'barva pozadí
rngBunka.Interior.Color = aPoleBarvy(i, 2)
End If
End If

'Borders.Color vrací Null,
'pokud všechna ohraničení nemají stejnu barvu

If iCil = 3 Or iCil = 0 Then
'barva horního ohraničení
With .Borders(xlEdgeTop)
If .Color = aPoleBarvy(i, 1) Then
.Color = aPoleBarvy(i, 2)
End If
End With

'barva pravého ohraničení
With .Borders(xlEdgeRight)
If .Color = aPoleBarvy(i, 1) Then
.Color = aPoleBarvy(i, 2)
End If
End With

'barva dolního ohraničení
With .Borders(xlEdgeBottom)
If .Color = aPoleBarvy(i, 1) Then
.Color = aPoleBarvy(i, 2)
End If
End With

'barva levého ohraničení
With .Borders(xlEdgeLeft)
If .Color = aPoleBarvy(i, 1) Then
.Color = aPoleBarvy(i, 2)
End If
End With

'barva ohraničení hlavní diagonály
With .Borders(xlDiagonalDown)
If .Color = aPoleBarvy(i, 1) Then
.Color = aPoleBarvy(i, 2)
End If
End With

'barva ohraničení vedlejší diagonály
With .Borders(xlDiagonalUp)
If .Color = aPoleBarvy(i, 1) Then
.Color = aPoleBarvy(i, 2)
End If
End With

End If

End With

Next rngBunka

Next i

Application.ScreenUpdating = True

End Sub

Příloha:
prebarveni.zip

Uložit článek jako PDF