|
Ve spolupráci se SEDUO jsem vytvořil několik videokurzů:
Jak vkládat a upravovat obrazce v Excel využitím VBA. Potřebujete-li do Excel vkládat a upravovat obrazce, můžete využít VBA, který otrockou práci udělá za vás.
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:
Přidání objektu je jednoduché - AddShape a máte hotovo:
*.AddShape (Type, Left, Top, Width, Height)
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 ;)
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 ;)
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"
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 ;)
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
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
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
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
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
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.
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ů
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á brvek čáru, tloušťku atd.
v přípravě
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ě
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, prostě nic nebude obsahovat, nebo zneviditelnit, záleží co a jak je potřeba.
ActiveSheet.Shapes("Obrazec_2").TextFrame.Characters.Text = ""
Sem budu sbírat zajiamavá řešení, která při práci s obrazci potkám.
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 ;)
Chcete se dozvědět více, můžete využít daalší související články:
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ě.
Napadá vás nějaké tip na doplnění, vylepšení článku? Budu rád za popostrčení.
Článek byl aktualizován: 19.09.2020 11:07
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.
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ů.
Můžete být prvními co zanechají smysluplný komentář.
Pomohl Vám návod? Sdílejte na Facebooku, G+ |
||
LinkedIn... |
Stránky o MS Office (Excel) produktu společnosti Microsoft. Neslouží jako technická podpora.
| Email na autora: pavel.lasak@gmail.com | Copyright © : Pavel Lasák 2004 - 2021 |