Tweet

Jak na obrazce v Excel VBA

Úvodem

Pro práci s obrazci v Excel můžete využít i VBA. Jak na to se dozvíte v tomto článku. Z důvodu přehlednosti je článek rozdělen na kapitoly:

• Trocha teorie - syntaxe
• Seznam obrazců
• Vložit požadovaný obrazec
• Smazat obrazec
• Úpravy obrazců
  • Pozice
  • Velikost
  • Barva pozadí
  • Čára, barvy, typ
  • Pořadí - dopředu, dozadu
  • Design - posunování puntíku
• Kontrola
  • Existuje
  • Velikost, pozice
  • Barva čáry
• Text
  • Vložit
  • Upravit
  • Smazat
• Tipy triky
• Další články
• Ke stažení

Trocha teorie - syntaxe

Přidání objektu je jednoduché - AddShape a máte hotovo:

*.AddShape (Type, Left, Top, Width, Height)

Argumenty

• Type - povinný - Jaký obrazec chcete vložit - následující kapitola
• Left - povinný - Pozice zleva
• Top - povinný - Pozice shora
• Width - povinný - šířka
• Height - povinný - výška

Seznam obrazců

Obrazců je k dispozici velká, množství, když už člověk narazí na seznam obrázku končí číslem 137, přitom obrazců je daleko více (neboli 183, ve skutečnosti 183 protože číslo 138 neobsahuje obrazec). Pokud chcete vědět proč, musíte se optat u Microsoftu ;)

Seznam

Nejlépe je se na obrazce kouknout jak vypadají. Vykreslíte skriptem (pozici zleva a shora máte, no a výšku a šířku buňky také ;) ) Jen 138 musíte přeskočit ;)

Vložit požadovaný obrazec

Když víte který obrazec chcete vložit, zbytek je hračka. Využijete buď číslo, nebo mso kód například pro 32 cípou hvězdu: msoShape32pointStar (což je číslo 96, viz seznam obrazců o kapitolu výše).

ActiveSheet.Shapes.AddShape(msoShapeRightArrow, 100, 60, 90, 70).Select ActiveSheet.Shapes.AddShape(msoShape16pointStar, 100, 60, 90, 70).Select ' nebo přes číslo obrazce ActiveSheet.Shapes.AddShape(96, 100, 60, 90, 70).Select

Výhoda pokud obrazci dáte název, následně se na něj můžete lépe odkazovat a efektivněji upravovat:

With ActiveSheet.Shapes.AddShape(msoShapeActionButtonHelp, 100, 60, 90, 70) .Name = "Obrazek_01" End With

S deklarací a SETováním

Dim ws As Worksheet Dim sq As Shape Set ws = ActiveSheet Set sq = ws.Shapes.AddShape(1, 50, 50, 100, 100) ' přidat jméno sq.Name = "Moje_Jmeno_007"

Smazat obrazec

Smazání, když vím jak se obrazec jmenuje

ActiveSheet.Shapes("Obrazec_2").Delete

Smazaní, když nadeklaruji a naSETuji

Dim myImage As Shape Set myImage = ActiveSheet.ShapesShapes("Obrazec_2") myImage.Delete ' netestuji zda objekt existuje

Smazat vše, ale pozor, tlačítko na listě je také shape ("obrazec"). Ale protože průběžně zálohujete, tak v případě chybného nasazení o data nepříjdete.

Dim ws As Worksheet Dim sp As Shape Set ws = ActiveSheet For Each sh In ws.Shapes sh.Delete Next sh ' Pozor smaže třeba i tlačítka ;)

Pozice

Jak na pozici obrazce posunout vpravo, vlevo, nahoru, dolů.

' Na jaké pozici se necházi PoziceLeft = Cells(5, 46).Left PoziceTop = Cells(5, 46).Top ' Nastavit Shapes("Obdélník 1").Top = 250 Shapes("Obdélník 1").Left = 1750

Nebo přes nasetování a deklaraci proměných:

Dim myImage As Shape Set myImage = ActiveSheet.Shapes("Obdélník 1") myImage.Top = 200 myImage.Left = 1500

Velikost

Jak na výšku a šířku obrazce neboli Shape?

ActiveSheet.Shapes("Obrázek 11").Width = 100 ActiveSheet.Shapes("Obrázek 11").Height = 10 ' nebo bez ActiveSheet Shapes("Obrazec_21").Width = 80 Shapes("Obrazec_21").Height = 100

Deklarace atd

Dim myImage As Shape Dim imageWidth As Double Dim imageHeight As Double Set myImage = ActiveSheet.Shapes("Obrázek 11") imageWidth = 100 imageHeight = 10

Rozměr přes měřítko

Změna rozměru přes měřítko - pouze pro poznámku, osobně vůbec nepoužívám

' přes měřítko ActiveSheet.Shapes("Obrazec_21").Select Selection.ShapeRange.ScaleHeight 1.1, msoFalse, msoScaleFromBottomRight ' nebo ActiveSheet.Shapes("Obrazec_21").Select Selection.ShapeRange.ScaleHeight 1.1, msoFalse ' přes měřítko výška i šířka ActiveSheet.Shapes("Obrazec_21").Select Selection.ShapeRange.ScaleHeight 1.1, msoFalse Selection.ShapeRange.ScaleWidth 1.1, msoFalse

Barva pozadí

Jak na změnu barvy pozadí včetně průhlednosti:

ActiveSheet.Shapes("Obrazec_2").Fill.Visible = msoTrue ' bez pozadí ActiveSheet.Shapes("Obrazec_2").Fill.ForeColor.RGB = RGB(25, 192, 15) ' průhlednost ActiveSheet.Shapes("Obrazec_2").Fill.Transparency = 0.3

Využitím Select

ActiveSheet.Shapes("Obrazec_2").Select With Selection.ShapeRange.Fill .ForeColor.RGB = RGB(25, 192, 0) End With

Pokud si budete kód nahrávat využitím nahráváním maker:

' co nahraje VBA nahráváním maker ActiveSheet.Shapes("Obrazec_2").Select With Selection.ShapeRange.Fill .Visible = msoFalse .ForeColor.RGB = RGB(25, 192, 0) .Transparency = 0 .Solid End With

Nastavení průhlednosti

ActiveSheet.Shapes("Obrazec_2").Select With Selection.ShapeRange.Fill .Transparency = 0.5 End With

Čára, barvy, typ

Jak na změnu čáry nejen barvy ale i typu (plná, tečkovaná) a také tloušťka:

ActiveSheet.Shapes("Obdélník 22").Line.Visible = msoTrue ActiveSheet.Shapes("Obdélník 22").Line.DashStyle = msoLineSysDash ActiveSheet.Shapes("Obdélník 22").Line.Weight = 2.25

nebo

Shapes("Obdélník 22").Line.Visible = msoTrue Shapes("Obdélník 22").Line.DashStyle = msoLineSysDash Shapes("Obdélník 22").Line.Weight = 2.25

Jaké linky:

msoLineDash msoLineDashDot msoLineDashDotDot msoLineDashStyleMixed msoLineLongDash msoLineLongDashDot msoLineRoundDot msoLineSolid msoLineSquareDot

Co se vám nahraje při nahrávání maker

ActiveSheet.Shapes("Obrazec_2").Select With Selection.ShapeRange.Line .Visible = msoTrue .DashStyle = msoLineSysDash .Weight = 2.25 End With

Pořadí - dopředu, dozadu

Přesouvání, může být více obrazců tak ne první pokus se přesune, protože "z" číslo prvku není vyšší nižší o jedničku. Neboli každý prvek má pořadí.

ActiveSheet.Shapes("Obrazec_21").ZOrder msoBringForward ActiveSheet.Shapes("Obrazec_21").ZOrder msoSendBackward

Přesunout do popředí do pozadí:

msoBringForward msoBringInFrontOfText msoBringToFront msoSendBackward msoSendBehindText msoSendToBack

Design u úprava v obrazci

Jak změnit design obrazce, nemyslím velikost, ale rozložení. neboli některé obrazce mají "zelené" tečky, kterými můžete měnit jeho tvar, třeba u šipky může být šipka plnější (tlustší) a čára užší, u smajlíka se může usmívat nebo mračit.

ActiveSheet.Shapes("Sipka_01").Adjustments.Item(2) = 0.5 ActiveSheet.Shapes("Sipka_01").Adjustments.Item(1) = 0.3

Nebo přes výběr

ActiveSheet.Shapes("Sipka_01").Select Selection.ShapeRange.Adjustments.Item(2) = 0.87245 Selection.ShapeRange.Adjustments.Item(1) = 0.18367

Tip, můžete si doplnit sami o deklaraci atd.

Existuje obrazec

Než obrazec upravíte, smažete tak je vhodné zkontrolovat, zda existuje

Dim shp As Shape Dim ws As Worksheet MsgBox ("Počet Shapes: " & ActiveSheet.Shapes.Count) For Each shp In ActiveSheet.Shapes MsgBox ("Type: " & shp.Type & "Name: " & shp.Name) ' pokud se chci podívat na typy Shapes Next shp 'Viz seznam Shapes a jejich typů

Velikost, pozice

Kde se nachází a jak je velký

MsgBox (ActiveSheet.Shapes("Obrázek 11").Width) MsgBox (ActiveSheet.Shapes("Obrázek 11").Height) MsgBox (ActiveSheet.Shapes("Obrázek 11").Left) MsgBox (ActiveSheet.Shapes("Obrázek 11").Top)

Jakou má barvu čára, pozadí ....

Jakou má brvek čáru, tloušťku atd.

v přípravě

Vložit text do obrazce

Vložit text do objektu

ActiveSheet.Shapes("Obrazec_2").TextFrame2.TextRange.Characters.Text = "JakNaExcel"

Vložit text do objektu, který nahraje nahrávání maker

ActiveSheet.Shapes.Range(Array("Obrazec_2")).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Ahoj" & Chr(13) & "JakNaExcel"

Další ukázky

V přípravě

Upravit text

Zarovnání

ActiveSheet.Shapes("Obrazec_2").TextFrame2.VerticalAnchor = msoAnchorMiddle Shapes("Obrazec_2").TextFrame2.TextRange.Characters(1, 11).ParagraphFormat.Alignment = ' msoAlignCenter

Viditelnost neviditelnost

ActiveSheet.Shapes("Obrazec_2").TextFrame2.TextRange.Characters.Font.Fill.Visible = msoFalse ' nebo pro určité znaky ActiveSheet.Shapes("Obrazec_2").TextFrame2.TextRange.Characters(1, 11).Font.Fill.Visible = msoFalse

Barvy využití ThemeColor

ActiveSheet.Shapes("Obrazec_2").TextFrame2.TextRange.Characters(1, 11).Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorText2

Barvy využití ColorIndex

ActiveSheet.Shapes("Obrazec_2").TextFrame.Characters.Font.ColorIndex = 3

Barvy využití Color

ActiveSheet.Shapes("Obrazec_2").TextFrame.Characters.Font.Color = RGB(10, 20, 20)

Další ukázky

v přípravě

Smazat text

Smazat text, prostě nic nebude obsahovat, nebo zneviditelnit, záleží co a jak je potřeba.

ActiveSheet.Shapes("Obrazec_2").TextFrame.Characters.Text = ""

Tipy triky

Sem budu sbírat zajiamavá řešení, která při práci s obrazci potkám.

Smazat všechny Shape objekty

Hodí se při pročišťování listů, pozor maže vše i tlačítka, obrázky:

Dim ws As Worksheet Dim sp As Shape Set ws = ActiveSheet For Each sh In ws.Shapes sh.Delete Next sh ' Pozor smaže třeba i tlačítka ;)

Další články

Chcete se dozvědět více, můžete využít daalší související články:

• Jak vložit do listu obrázek - Excel VBA
• ...

Ke stažení

Soubor ke stažení zdarma je připraven pro patrioty webu. Neboli osůbky co podpoří tento web. Ostatní si veškeré kódy Ctrl + C > Ctrl + V mohou překopírovat a samostatně v rámci samostudia vyzkoušet.

Chcete ušetřit čas? Můžete se stát patriot na https://www.patreon.com/JakNaExcel. Děkuji za podporu webu. Ať může být článků více do větší hloubky a pravidelně.

Závěrem

Napadá vás nějaké tip na doplnění, vylepšení článku? Budu rád za popostrčení.

Článek byl aktualizován: 31.05.2019 10:58

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 zatím nejsou

Můžete být prvními co zanechají smysluplný komentář.