Jste zde: Úvodní stránka » excel » vba-listy-bunky » formatovani-bunek-excel-vba

Formátování buněk - kódy Excel VBA

Videokurzy Excel

Ve spolupráci se SEDUO jsem vytvořil několik videokurzů:

Jak na Excel - naučte se efektivně využívat Excel - nejoblíbenější (Hodnocení 97%, přes 13.000 studentů, + 750 pozitivních zpětných vazeb) - Získat kurz
MaxiKurz Excel - získejte lepší práci, více peněz, staňte se nepostradatelní (přes 6 hodin videí, 160 lekcí) - Získat kurz
G tabulky... - pokud nemáte rádi Excel využijte kurz na Google-tabulky

Jak pomocí kódu VBA nastavovat formát buňkám. Tučné písmo, šířka sloupce, řádků, ....

Doplněno 26.10.2014 (doplněn sešit ke stažení)

Úvodem

Pro přehlednost je článek rozdělen na kapitoly, které se týkají nastavování formátu buněk. K dispozici je zatím:

Výška - šířka buňky automaticky
Šířka / výška - pevně zadaná
Zalomit text / upravit výšku automaticky
Sloučit/rozdělit buňky
Ohraničení buňky
Barva buňky pozadí buňky
Formát čísla v buňce
Barvy, font, motiv, velikost textu v buňce
Zarovnání a orientace textu - odsazení ...
uzamknout - skrýt vzorce
Sešit ke stažení - zdarma NEW - Nově!
Související články
V přípravě - na základě případných komentářů

Výška - šířka buňky automaticky

Jak automaticky upravit výšku a šířku (více řekne ukázka na obrázku) buňky pomocí VBA .


    With Me.Cells 
        .Rows.AutoFit 
        .Columns.AutoFit 
    End With

Šířka / výška - pevně zadaná

Jak změnit šířku / výšku buňky.

výška


    With Me.Cells 
        .Rows.RowHeight = 12 
    End With

pro jeden řádek (buňku)


	Range("A1").RowHeight = 90

Šířka


    With Me.Cells
        .Columns.ColumnWidth = 20
    End With

Aktuální velikost buňky


MsgBox "Buňka: Výška = " & Range("A1").RowHeight & vbCrLf & "Šířka = " & Range("A1").ColumnWidth

Zalomit text / upravit výšku automaticky

Jak zalomit text v buňce a automaticky upravit výšku buňky (řádku).


    Range("B2").WrapText = True
    Range("B2").EntireRow.AutoFit

Sloučit/rozdělit buňky

Jak sloučit buňky B10:C10 pomocí VBA:


Range("B10:C10").Merge

Jak rozdělit buňky B10:C10 pomocí VBA:


Range("B10:C10").UnMerge

Ohraničení buňky

Jak nastavit ohraničení (borders) buňky pomocí VBA v Excelu?


    Range("B32").Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With


    Range("B32").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlHairline
        .ColorIndex = xlAutomatic
    End With

Odstranění ohraničení:


    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Poznámka: Jak na ohtaničení buňky bude sepsáno podrobněji v samostatném článku. Typy ohraraničení (linky), tloušťka, barvy ohraničení. Umístění ohraničení (horní, dolní, levé, ...)

Barva buňky

Pomocí VBA změnit barvu (pozadí) buňky aktivní:


  ActiveCell.Interior.ColorIndex = 26

Pomocí VBA změnit barvu (pozadí) buňky B43, zadání RGB:


  Range("B43").Interior.Color = RGB(200, 160, 35)

nebo přes Cells


  Cells(1,1).Interior.Color = RGB(200, 160, 35)

Pokud je potřeba mít buňku bez výplně:


  ActiveCell.Interior.ColorIndex = xlNone

Formát čísla v buňce

Jak nastavit formát čísla buňce Excelu pomocí VBA :


Cells(1,1).NumberFormat = "@"

Range("A1").NumberFormat = "General"

Podrobněji v samostatných článcích. Zatím je k dispozici:

Formát pro datum a čas

Barvy, font, velikost textu v buňce

Jak na změnu barvy:


Range("B2").Font.Color = RGB(255, 0, 0)
' nebo
Range("B2").Font.ColorIndex = 26
' nebo
Cells(2,2).Font.ColorIndex = 26

řez fontu (tučné, kurzíva):


' tučné
Range("B2").Font.Bold = True
' netučné
Range("B2").Font.Bold = False
' kurzíva
Range("B2").Font.Italic = True

Změna velikosti fontu:


Range("B2").Font.Size = 20
' nebo
Cells(2,2).Font.Size = 20

Změna fontu (motivu) na Arial:


Range("B2").Font.Name = "Arial"
' nebo
Cells(2,2).Font.Size = 20

hromadná změna několika parametru fontu:


Range("B79:B80").Select
   With Selection.Font
      .Color = RGB(0, 0, 255)
      .Italic = True
      .Size = 12
      .Name = "Arial"
   End With

Podrobněji v samostatném článku, kde výše uvedené kódy doplním odalší možností (příklady).

Zarovnání a orientace textu

Zarovnání textu pomocí VBA


   Range("B86").HorizontalAlignment = xlCenter
   Range("B86").VerticalAlignment = xlCenter

Orientace textu


   Range("B88").Orientation = 90

Odsazení textu


   Range("B88").IndentLevel = 3

směr textu


   Range("B88").ReadingOrder = xlContext
' další možnost
   Range("B88").ReadingOrder = xlRTL

Uzamknout - skrýt vzorce

Jak zamykat a skrývat vzorce?


    Range("B98").Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Podrobněji toto téma bude popsáno v samostatném článku.

Ke stažení

Soubor Formát - praktické příklady - Excel VBA ke stažení zdarma. Soubor využívá makra (pro Excel 2007 a novější).

Další související články:

Pokud už máte buňku (oblast) označenou můžete s ními dále pracovat například

RESIZE, OFFSET - zvětšit posounout oblast
Zapiš údaj do buňky (oblasti)
Přečti údaj z buňky (oblasti)
Formátování buněk datum a čas
...

V přípravě

V přípravě další VBA kódy týkající se formátování buněk.


' v přípravě

Závěrem

Máte svůj oblíbený kód, které ještě není uveden. Můžete se pochlubit v komentářích.

Článek byl aktualizován: 01.11.2014 14:15

Odměna

Ušetřil vám tento web čas, peníze? Pomohl vyřešit problém? Jste ochotni poskytnout symbolickou odměnu na další rozvoj? Vybrte si formu odměny, která vám vyhovuje.

Pavel Lasák - autor webu

Microsoft Office (Word, Excel, Google tabulky, PowerPoint) se věnuji od roku 2000 (od 2004 na této doméně) - V roce 2017 jsem od Microsoft získal prestižní ocenění MVP (zatím jsem jediný z ČR v kategorií Excel). Své vědomosti a zkušenosti dávám k dispozici i on-line ve videích pro SEDUO. Ve firmách školím a konzultuji, učím na MUNI. Tento web již tvořím přes 15 let. Zdarma je zde přes 1.000 návodu, tipů a triků, včetně přes 250 různých šablon, sešitů.

Komentáře

Marty

Přidáno: 04.03.14 16:07

Zdravím, jsem v tom začátečník a na stránkách se učím chápat problematiku VBA. Zkoušel jsem záhlaví dle příkladu: Sub VlozitZapati() With ActiveSheet.PageSetup .LeftFooter = Range("A1") .CenterFooter = "Za tento rok vyděláno" .RightFooter = "" End With End Sub Jak mohu provést zápis dat na jeden řádek a ne dle rozdělení doleva,vpravo, na střed. Něco v tom smyslu, kdybych chtěl sloučit 2 texty a jeden je číslice nějakého výpočtu, např: "Za tento rok vyděláno 0,-Kč. Kde 0 je A1. Lze nějak texty spojovat tak abych mohl uvádět do záhlaví malou statistiku hodnot ve větším rozsahu než jen LEFTFOOTER, RIGHT, CENTER,..... Děkuji

Pepan

Přidáno: 19.03.14 12:46

Dobrý den, rád bych změnil barvu buňky nikoliv přes konkrétní číslo barvy, ale zvolením buňky, která tuto barvu už má. Zkoušel jsem to následujícím způsobem, ale objevila se chyba v syntaxu "Interior.Color.Copy" Můžete mi s tím, prosím, poradit? Zde je zjednodušená část postupu: Range(A1).Select Range(adresaBunkySCilovouBarvou).Interior.Color.Copy If Range(adresaBunkySBarvouKeZmene).Interior.Color = ActiveCell.Interior.Color Selection.Paste End if Děkuji.

Foglik

Přidáno: 15.05.14 23:01

2Pepan: Nepoužíval bych "Interior.Color.Copy", ale načetl bych do proměnné hodnotu barvy a pak ji přiřadil ostatním buňkám.

Petr

Přidáno: 30.07.14 13:24

Dobrý den, potřebuji nastavit barvu buňky na "bez výplně". Zkoušel načíst hodnotu barvy buňky ( vrátí 16777215), když tuto hodnotu použiju na jinou buňku tak buňka dostane bílou barvu. Jak na to prosím? Děkuji

David

Přidáno: 12.08.14 15:28

Petr: Range(adresa).Interior.Pattern = xlNone V podobných přápadech je užitečné analyzovaz záznam makra, kdy si to "ručně naklikáš" a v kodu pak vyhledáš to své klíčové slovo

Pavel Lasák

Přidáno: 26.10.14 08:42

To Petr: Pro buňku bez výplně použít XlNone

Jojo

Přidáno: 29.10.14 14:56

To Pavel Lasák: -- V podnadpise: "Změna fontu (motivu) na Arial:" v riadku pre Cells bolo mienené pravdepodobne: Cells(2,2).Font.Name = "Arial"

R3sidento

Přidáno: 26.11.14 14:15

Zdravím měl bych dotaz ohledně sloučení řádků. Při ukládání nového zákazníka používám následující kód na určení nového řádku. PosledniPlnyRadek = ThisWorkbook.Worksheets("Zákazníci").Range("A2").End(xlDown).Row Radek = PosledniPlnyRadek + 1 Funguje bezva. Ale nevím jaký kód použít například na sloučení 5 až 7 sloupce, v práve vytvořeném řádku. Pokud ukládám nějaká data do vytvořeného řádku používám kó: ThisWorkbook.Worksheets("Zákazníci").Cells(Radek, 1).Value = f_jmeno.Value Prosím poraďte jak na to sloučení, děkuji

Jojo

Přidáno: 01.12.14 09:04

To Pavel Lasák: -- Hore v podnadpise: "Barvy, font, velikost textu v buňce" a v odseku: "Změna fontu (motivu) na Arial: je napísané takto:Range("B2").Font.Name = "Arial" ' nebo Cells(2,2).Font.Size = 20keď sa má jednať o zmenu fontu na Arial, nemalo by tam byť správne:Cells(2,2).Font.Name = "Arial"?

venca

Přidáno: 19.10.15 09:11

Zdravím, potřeboval bych poradit. Mám nalezeno číslo posledního řádku v listu a to bych chtěl použít pro obarvení různých sloupců v listu od řádku 2 do posledního. Nedaří se mi zadat rozsah od - do - viz. pokus pro sloupec "D" níže. Pokud to takto lze vůbec udělat. Děkuji za radu. Sub Makro1() PosledniPlnyRadek = Range("C1").End(xlDown).Row ' Ve sloupci C MsgBox "PosledniPlnyRadek má číslo: " & PosledniPlnyRadek Range ("D2: "PosledniPlnyRadek").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With End Sub

Standa

Přidáno: 29.08.16 09:20

Dobrý den, řeším jeden problém. V jedné buňce mám text. V té buňce označím pouze část textu (ne všechen) a naprogramované tlačítko by mělo změnit formát (třeba barvu) pouze označeného textu a ostatní text v buňce nechat bezezměny. Už jsem zkoušel různé možnosti, ale skončilo to pokaždé změnou formátu celé buňky. Chtěl bych se optat, zda by tento problém šel nějak vyřešit. Předem Vám děkuji za odpověď.

Jakub

Přidáno: 14.09.16 07:28

Zdravím, potřeboval bych nastavit mřížku v celém listě. With Me.Cells .Rows.RowHeight = 15 .Columns.ColumnWidth = 0.42 End With Tento kód mi nastaví v celém listě jednotnou jednoduchou mřížku, ale já bych potřeboval: první sloupec: 2.14 druhý sloupec: 0.42 třetí sloupec: 2.14 čtvrtý sloupec: 0.42 ... první řádek: 15 druhý řádek: 3.75 třetí řádek: 15 ... Věděl by někdo jak na to??? Děkuji za radu

Jakub

Přidáno: 14.09.16 08:15

x = 1 While x <= 1048576 Rows(x).RowHeight = 15 x = x + 1 Rows(x).RowHeight = 3.75 x = x + 1 Wend Toto funguje, ale rozhodně to není ideální řešení. Dlouho to trvá a nedoběhne to do konce.

Jojo

Přidáno: 16.09.16 11:32

To Jakub: -- vytvorenie zdvojenej mriežky pre celý list (u mňa cca 22 sec)Dim rw, rw2 Dim Rng1 As Range Dim Rng2 As Range Dim Rng3 As Range Dim Rng4 As Range Const v1 As Byte = 15 ' výška1 Const v2 As Currency = 3.75 ' výška2 Const s1 As Currency = 2.14 ' šírka1 Const s2 As Currency = 0.42 ' šírka2 CalcOLD = Application.Calculation With Application .Calculation = xlCalculationManual ' neaktualizovať hodnoty v bunkách .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False .Cursor = xlWait On Error Resume Next For rw = 1 To 1048576 Step 62 .StatusBar = rw Set Rng1 = Cells(rw, 1) Set Rng2 = Cells(rw + 1, 1) Set Rng3 = Cells(1, rw) Set Rng4 = Cells(1, rw + 1) For rw2 = rw + 2 To rw + 60 Step 2 'výška Set Rng1 = Union(Rng1, Cells(rw2, 1)) Set Rng2 = Union(Rng2, Cells(rw2 + 1, 1)) 'šírka Set Rng3 = Union(Rng3, Cells(1, rw2)) Set Rng4 = Union(Rng4, Cells(1, rw2 + 1)) Next rw2 Rng1.RowHeight = v1 Rng2.RowHeight = v2 Rng3.ColumnWidth = s1 Rng4.ColumnWidth = s2 Next rw On Error GoTo 0 End With With Application .Calculation = CalcOLD .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True .Cursor = xlDefault .StatusBar = False End With

Jakub

Přidáno: 16.09.16 11:40

To Jojo: Díky moc, předpokládám ale, že to rychleji nepůjde? U mě to trvá cca 45s a na jednom slabším PC cca 90s. Další věc je vertikální posuvník. Je možnost, jak ho zachovat viditelný, ale aby byl oproti nově otevřenému listu zachován. Tj. aby se metodou chytni a táhni nedalo odrolovat až nakonec. Viz posuvník horizontální. Kód: With Me.Cells .Rows.RowHeight = 15 .Columns.ColumnWidth = 0.42 End With Upravuje též celou stránku, trvá zlomek času a posuvníky zůstanou nezměněny.

Jakub

Přidáno: 16.09.16 12:03

Do-zdůvodnění: Rozměry buněk jsou základní, chtěl bych umožnit měnit jejich rozměr dle aktuálních požadavků, ale vždy dva rozměry na střídačku. To už není problém napsat, ale ten čas je dost omezující. Kdyby šlo jen o vytvoření mřížky, se kterou už by se poté nehýbalo, tak by to takový problém nebyl.

Jojo

Přidáno: 16.09.16 12:04

To Jakub: -- Zrýchlenie/Skrátenie času na polovicu (8,8sec)Sub ZdvojenaMriežka() 'SpeedUp Dim rw, rw2 Dim Rng1 As Range 'Dim Rng2 As Range Dim Rng3 As Range 'Dim Rng4 As Range '~~> Tu nastaviť parametre Const Sh As String = "Hárok1" ' List/Sheet Const v1 As Byte = 15 ' výška1 Const v2 As Currency = 3.75 ' výška2 Const s1 As Currency = 2.14 ' šírka1 Const s2 As Currency = 0.42 ' šírka2 tim = Timer 'Zrýchliť CalcOLD = Application.Calculation With Application .Calculation = xlCalculationManual ' neaktualizovať hodnoty v bunkách .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False .Cursor = xlWait 'Všetky bunky rovnako With Sheets(Sh).Cells .Rows.RowHeight = v2 .Columns.ColumnWidth = s2 End With 'Každá druhá bunka rovnako On Error Resume Next For rw = 1 To 1048576 Step 62 ' .StatusBar = rw Set Rng1 = Cells(rw, 1) ' Set Rng2 = Cells(rw + 1, 1) Set Rng3 = Cells(1, rw) ' Set Rng4 = Cells(1, rw + 1) 'Zrýchlenie cez Union(aby ich nenastavoval po jednom)(max 30 argumentov) For rw2 = rw + 2 To rw + 60 Step 2 'výška Set Rng1 = Union(Rng1, Cells(rw2, 1)) ' Set Rng2 = Union(Rng2, Cells(rw2 + 1, 1)) 'šírka Set Rng3 = Union(Rng3, Cells(1, rw2)) ' Set Rng4 = Union(Rng4, Cells(1, rw2 + 1)) Next rw2 'Nastav výšku/šírku Rng1.RowHeight = v1 ' Rng2.RowHeight = v2 Rng3.ColumnWidth = s1 ' Rng4.ColumnWidth = s2 Next rw On Error GoTo 0 End With 'Spomaliť With Application .Calculation = CalcOLD .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True .Cursor = xlDefault ' .StatusBar = False End With MsgBox Timer - tim End Sub

Jojo

Přidáno: 16.09.16 12:51

To Jakub: -- Tej otázke s posuvníkom neie ceľkom rozumiem...

Jojo

Přidáno: 16.09.16 14:00

To Jakub: -- Ak som dobre pochopil otázku o posuvníku, tak by mohlo pomôcť použiť: "ScrollArea" Napr.: Sheets("Hárok1").ScrollArea = "A1:F10", ak nie, tak prosím o iný popis problému.

Jakub

Přidáno: 19.09.16 07:53

Nejlepší to bude obrázkem: " https://ulozto.cz/!7DaA6Lfdf/scrollbar-jpg " Čas 14 / 27 sec je přijatelná, díky. A při té příležitosti bych měl ještě jednu otázku, je i nějak možné zadávat přes makro rozměr buňky v Pixelech? Abych místo šířky 2,14 a výšky 15,00 zadal pouze 20. Jak už jsem se zmínil, rozměr bych chtěl měnit, vždy se bude jednat o "čtverce", tak abych to nemusel pořád přepočítávat. Výška řádku je jednoduchá (X=PX*0,75) a to by makrem šlo, ale šířka nemá stejný poměr hodnota ku PX. Abych mohl zadat jen: 20px a 5px namísto 15,00 / 2,14 a 3,75 / 0,42. Děkuji za radu

Jojo

Přidáno: 20.09.16 07:35

To Jakub: -- 1) K obrázku sa žial neviem dostať 2) Pre prevod medzi pixels a chars platí približne: chars = (pixels - 5) / 7 pixels = (chars * 7) + 5

Jojo

Přidáno: 20.09.16 07:57

To Jakub: -- chars = (pixels - 5) / 7 -- pixels = (chars * 7) + 5

Jakub

Přidáno: 20.09.16 09:26

To Jojo: 1) http://www.jpeg.cz/images/2016/09/20/48QMV.jpg - nevím, jak sem hodit funkční odkaz. Pokud ani toto nepůjde zobrazit, tak to nechme plavat. dělá to problém, když bych se chtěl dostat na př. řádek 500 - posuvníkem mi to pak skáče mezi nulou a cca 1200tým řádkem a rolování kolečkem myši je nepraktické a PageDown mnoho lidí nepoužívá. 2) Pro rozměr od 20px nahoru je to perfektní a pro nižší hodnoty si udělám podmínku s nadefinovanýma hodnotama.

Jojo

Přidáno: 20.09.16 13:58

To Jakub: -- Posuvník sa zmenšil preto(a preto robí tie skoky), lebo sa zapisovalo až do posledného riadku, ale: -- 1) Podľa mňa by nemal byť problém vysvetliť(napísať návod :-) ), aby používali klávesy PageUp, PageDown -- 2) Rolovanie je možné aj kliknutím na pás pod posuvník. (Posúva podobne, ako PageDown). Miesto krátkeho kliknutia, je možné aj podržať stlačené ľavé tlačítko na myši => bude rolovať, ako pri podržaní PageDown. Horšie je to (v tomto prípade, pri nízkych číslach riadkov, rolovať späť - ťažko sa triafa myšou nad posuvník) -- 3) Iná možnosť je zapísať cieľovú adresu (napr. A500) do "Poľa názvov" (v ľavom obrázku tam je A1) -- 4) Nakresliť mriežku s menším počtom riadkov (podľa predpokladaného skutočného využitia). ==> (Aj súbor bude menší.)

Jakub

Přidáno: 21.09.16 06:45

To Jojo: To s tím zápisem po řádcích mě napadlo, ale nezapisovlo se stejně i do sloupců? 1,2) Posun nakonec asi nebude třeba, použiju vyhledávání přes makro přímo ve formuláři. 3) Tato možnost mi nepříjde úplně vhodná, takto hrozí nechtěné přejmenování buněk a nemuselo by pak správně fungovat odkazování na buňky ve funkcích. 4) Tato varianta mě také napadla, chtěl jsem jen předejít tomu, že by se někdy dosáhlo posledního naformátovaného řádku a následné úpravě po řádcích. Jen jsem netušil, že se mi to takto zkomplikuje. Přesto moc děkuji. Hlavní problém je vyřešen a s kosmetickýma vadama už si nějak poradím.

Marcela

Přidáno: 05.12.16 17:27

Ahoj, poradili byste mi, jak ve všech buňkách v listu, ve kterých není vzorec, nastavit barvu písma třeba červenou? (potřebuji označit hodnoty=proměnné). Děkuji