Jste zde: Úvodní stránka » excel » vba-pas-karet-ribbon-menu » vyjizdeci-menu-VBA

Vyskakovací menu - 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 v Excel VBA vytvořit vyskakovací menu. Nebo-li po "najetí" myší na objekt (např. obdélník) se tento rozbalí (zvětší).

Využijeme události.

Jak na vyskakovací menu ve VBA

Pro přehlednost je článek rozdělen na kapitoly pro snadnější orientaci:

Ukázka co potřebujeme
Vytvořit Label (Popisek) - tento bude reagovat po najetí myší
Vytvořit obdélník - tento se bude zvětšovat
Makro, které obdélník zvětší
Reakce na událost
Hotovo
Související články
Ke stažení

Ukázka co potřebujeme

Po najetí do určité oblasti potřebujeme změnit obdélník. U nás s písmenem "P", Objekt (obdélník) změní rozměry. Pro ukázku je ponechán název popisku Label.

Vytvořit Label (Popisek)

Nejprve vytvořit dva popisky z menu Vývojář (Developer). Vyložte dva popisky (Label) z Vložit (Active X)

Vytvořit obdélník

Vytvoříme obdélník z Vložení - Obrazce - Obdelník. Nebudu řešit barvičky atd. Zkontroluji velikost (jak bude vypadat malý a jak velký). Např. cca:

Původní rozměry 0,77 cm a 3,15 cm převedeme na body 25 a 115.

Makro, které obdélník zvětší

Vytvoříme dvě makra jedno obdélník zvětší a jedno obdélník zmenší. Pro jistotu před testováním makra zkontrolujte, že obdélník je pojmenován "Obdelnik_1".

Pro zvětšení


' Obdelnik_1
Dim Hloubka As Integer

With ActiveSheet.Shapes("Obdelnik_1")
    For Hloubka = 25 To 115
     .Width = Hloubka
    Next Hloubka
End With
ActiveSheet.Shapes("Obdelnik_1").TextFrame.Characters.Text = "Pavel"

Pro zmenšení


' Obdelnik_1
Dim Hloubka As Integer

With ActiveSheet.Shapes("Obdelnik_1")
    For Hloubka = 115 To 25 Step -1
     .Width = Hloubka
    Next Hloubka
End With
ActiveSheet.Shapes("Obdelnik_1").TextFrame.Characters.Text = "P"

Otestujeme, ještě můžete doplnit o vložení textu:


ActiveSheet.Shapes("Obdelnik_1").TextFrame.Characters.Text = "Pavel"

Pokud zafunguje, můžete překopírovat kódy do module. Nezapomenout na názvy procedur:


Sub Zvetsit()
' Obdelnik_1
Dim Hloubka As Integer

With ActiveSheet.Shapes("Obdelnik_1")
    For Hloubka = 25 To 115
     .Width = Hloubka
    Next Hloubka
End With
ActiveSheet.Shapes("Obdelnik_1").TextFrame.Characters.Text = "Pavel"
End Sub


Sub Zmensit()
' Obdelnik_1
Dim Hloubka As Integer

With ActiveSheet.Shapes("Obdelnik_1")
    For Hloubka = 115 To 25 Step -1
     .Width = Hloubka
    Next Hloubka
End With
ActiveSheet.Shapes("Obdelnik_1").TextFrame.Characters.Text = "P"
End Sub

Reakce na událost

Zbývá jen vytvořit reakce na událost přejetí popisek Labelu:


Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Call Zmensit
End Sub

Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Call Zvetsit
End Sub

Hotovo

Hotovo. Povedlo se?

Můžete ještě změnit barvy, odstranit názvy z popisek (Label), jsou jako pomůcka, aby fungovalo vyskakování.

Umístit na okraj a následně mít efektní menu jako na webu.

Související články

Související články:

Pás karet od A do Z - využitím VBA

Ke stažení

Soubor ke stažení zdarma je v přípravě. Podpořit zveřejnění můžete podporou na Patreon.

Závěrem

Narazili jste na nějaký problém, máte tip na vylepšení nebo doplnění článku, můžete zmínit v komentářích.

Článek byl aktualizován: 06.05.2022 13:05

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ů.