Přeskočit navigaci | Přeskočit na novinky

Jste zde: Úvodní stránka » excel » vba-listy-sheet » Worksheet_BeforeRightClick-Worksheet_BeforeDoubleClick

Události listu Worksheet_BeforeRightClick, Worksheet_BeforeDoubleClick

Videokurzy Excel

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

Kromě klasické provedení požadované akce, změnte pomocí události předvidatelné chování Excelu - například zamezte zobrazování kontextové nápovědy při pravém kliku myší.

Úvodem do Worksheet_BeforeRightClick, Worksheet_BeforeDoubleClick

Jako všechny události po jejím "odchycení" bude provedena požadovaná akce (například zobrazení dialogového okna. Pokud ale nastavíte argument Cancel na hodnotu True můžete zrušit přednastavené chování Excelu (napřílad nezobrazit kontextovou nabídku). Protože nastane událost a teprve po ní se provádí ono zobrazování kontextové nabídky, takže v události můžete nastavit její nezobrazování.

S těmito nastaveními opatrně, může znást nejen uživatelé, kteří si budou myslet, že jim excel nefunguje, ale může způsobit problémi i Vám pokud budete hledat případnou chybu v kódu.

Ukázkový kód (1) Worksheet_BeforeRightClick

Nejednodužší ukázka jednoduše deaktivuje zobrazení kontextového menu po kliku na pravým tlačítkem myši.

Private Sub Worksheet_BeforeRightClick(ByVal target as Range, ByRef cancel as Boolean) ' cancel - provede deaktivaci cancel = True End Sub

Ukázkový kód (2) Worksheet_BeforeRightClick

Při kliku pravým tlačítkem myši se objeví dialogové okno. Poté "vyskočí" kontextové menu pro danou buňku.

Private Sub Worksheet_BeforeRightClick(ByVal target as Range, ByRef cancel as Boolean) MsgBox ("Byl proveden klik pravým tlačítkem myši!") End Sub

Ukázkový kód (3) Worksheet_BeforeRightClick

Při kliku pravým tlačítkem myši přičtu do dané buňky hodnotu 2 a navíc nezobrazím kontextové menu.

Private Sub Worksheet_BeforeRightClick(ByVal target As Range, ByRef cancel As Boolean) ' Klikem do buňky přičtu 2 Dim HodnotaBunky As Integer HodnotaBunky = target.Value HodnotaBunky = HodnotaBunky + 2 target.Value = HodnotaBunky ' nezobrazím dialogové okno cancel = True End Sub

Ukázkové kódy pro Worksheet_BeforeDoubleClick

Po dvojkliku se v buňce nezobrazí kurzor

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True End Sub

Po dvojkliku obdržíte dialogové okno

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) MsgBox ("Byl proveden dvojklik pravým tlačítkem myši!") End Sub

Kombinace předchozích

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) MsgBox ("Byl proveden dvojklik pravým tlačítkem myši!") Cancel = True End Sub

Závěrem

Další informace o událostech listu jsou v souhrném článku: Události listu v MS Excel VBA - Pro další náměty k čemu využíváte událost SelectionChange jsou k dispozici komentáře.

Článek byl aktualizován: 19.09.2020 11:07

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

Pavel Lasák

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

   Pavel Lasák LinkedIn Profil    Pavel Lasák Google+ Profil    Pavel Lasák facebook Profil    Pavel Lasák twitter Profil


Komentáře


Martin

Přidáno: 21.08.13 14:30

Dobrý den. pro ty koho by zajmalo jak nastavit danou událost jen pro určitou oblast(oblasti). Osobně ještě nevim co ten příkaz ověřuje a vrací, ale funguje :) Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) If Not Intersect(Target, Range("B2:B25, L2:L25")) Is Nothing Then 'Váš kód pro danou oblast End If End Sub

Pavel Lasák

Přidáno: 21.08.13 20:17

To Martin: Děkuji za doplnění.

Vyplnění dat

Přidáno: 28.02.14 15:12

Dobrý den, jsem ve VBA úplný nováček, nikdy jsem v tom nedělal. Problém: Na List1 mám tabulku, v řádcích jsou údaje z pokladního deníku a já potřebuji, aby se např. po kliknutí na tlačítko / buňku vypsaly hodnoty do List2 - výdajový doklad a nebo pokud je to příjem, tak do List3 - příjmový doklad. Už nad tím sedím půl den a nic. Děkuji mnohokráte za pomoc!

Pavel Lasák

Přidáno: 01.03.14 19:56

To Vyplnění dat: Musí být nějaký příznak jak má excel poznat kam psát data. Do dalšího sloupce vyplnit, zda se jedna o příjem/výdej.

Andrea

Přidáno: 06.01.16 10:20

Dobrý den, prosím o radu. Ve VBA jsem amatér, proto nevím, proč mi makro nechce fungovat. Mám na Listech udělané jednotlivé přehledy mých dat - něco jako One pager. Pro vyhodnocení jsou na 3 místech tohoto přehledu vloženy vždy 4 obrázky. Potřebuji, aby se po kliknutí na daný obrázek rozsvítil (tím, že kolem něj bude "záře") a při dalším kliknutí zase zhasl. Nejlépe, aby z té čtveřice obrázků vždy mohl svítit jen jeden(něco jako semafor). Prozatím jsem "vymyslela" toto: Sub Makro2() ' Makro2 Makro If ActiveSheet.Shapes.Range(Array("Picture 49")).Select Selection.ShapeRange.Glow.Radius = 0 With Selection.ShapeRange.Glow .Color.ObjectThemeColor = msoThemeColorAccent2 .Color.TintAndShade = 0 .Color.Brightness = 0 .Transparency = 0.599999994 .Radius = 18 End With Then ActiveSheet.Shapes.Range(Array("Picture 49")).Select Selection.ShapeRange.Glow.Radius = 0 With Selection.ShapeRange.Glow .Color.ObjectThemeColor = msoThemeColorAccent2 .Color.TintAndShade = 0 .Color.Brightness = 0 .Transparency = 0 .Radius = 0 End With End If If ActiveSheet.Shapes.Range(Array("Picture 49")).Select Selection.ShapeRange.Glow.Radius = 0 With Selection.ShapeRange.Glow .Color.ObjectThemeColor = msoThemeColorAccent2 .Color.TintAndShade = 0 .Color.Brightness = 0 .Transparency = 0 .Radius = 0 End With Then ActiveSheet.Shapes.Range(Array("Picture 49")).Select Selection.ShapeRange.Glow.Radius = 0 With Selection.ShapeRange.Glow .Color.ObjectThemeColor = msoThemeColorAccent2 .Color.TintAndShade = 0 .Color.Brightness = 0 .Transparency = 0.599999994 .Radius = 18 End With End If End Sub Jak říkám, bohužel mi toto makro nefunguje. Fungovalo, než jsem začla podmínkovat s IF a THEN (což jsem našla zde a děkuji za to), ale nevím asi úplně přesně jak to použít. Děkuji za případné rady.

Pavel Lasák

Přidáno: 06.01.16 21:34

To Andrea: Nejprve je potřeba reakce na událost klik na obrázek: Sub MakroReagujeNaKliknutiNaObrazek_ImageClick() Dim sht As Worksheet Dim shp As Shape Set sht = ActiveSheet Set shp = sht.Shapes(1) ' spustení příslušného makra shp.OnAction = "Makro1" End Sub pak správně použít It then elseif

Roman

Přidáno: 14.08.16 08:51

Dobrý den, asi mám dlouhé vedení, ale pořád mi to nefunguje. Potřeboval bych makro, které se aktivuje, když udělám double-click na jakoukoliv buňku sloupce "G". Můžete mi prosím poradit jak to mám zapsat? Mimochodem, zkoušel jsem všechny vzorové makra na double-click, ale nefunguje mi žádné. :-(

hhcg

Přidáno: 23.12.16 06:49

nike mercurial soccer cleats

Canada Goose Womens Coats

Air Max Femme Pas Cher Soldes

australia uggs outlet

zapatillas nike baratas

new jordan releases

nike sb stefan janoski

Moncler Store

cheap uggs for women

longchamp tote bag

Veste Moncler Femme

australia uggs outlet

Ray-Ban Official Discounted Site

Oakley Outlet

Toms Outlet Online

ugg boots classic

ugg boots cheap

pandora beads

Moncler Soldes

nike boty dámské

canada goose jacket outlet

nike joggesko

Womens Ugg Boots

běžecké boty nike

nike jordan shoes

sac coach soldes

air jordan

Nike Online Store

hogan rebel donna

nike sneakers

23 is back

chaussure basket homme

billige nike sko

Jordan Sneakers For Sale

air force one pas cher

louboutin heels

reebok running shoes

Nike Air Jordan 11

new yeezy shoes

zapatillas running

Air Max Sneakers

canada goose coats

Ugg Noir Pas Cher

toms sale

Michael Kors

Jordan Future

Boutique Ugg

Ugg Button

ugg outlet online

Adidas Shoes Discount Marketplace

Canada Goose Official Site

hyperdunk 2014

Air Max 90

moncler outlet

Canada Goose Outlet Store

pandora jewelry store

scarpe hogan outlet

Nike Zapatos

retro jordans for cheap

Nike Air Max Soldes

hogan scontate

Nike Black Friday

nike air jordan pas cher

Doudoune Moncler Pas Cher

Ugg Femme Pas Cher

Doudoune Femme Pas Cher

Ugg Classic Tall

nike air schuhe herren

fitflops sale uk

Uomo Hogan

Cheap Stone Island Jackets

Sportschuhe Nike

Jordan Schoenen

Moncler Sale

Air Nike

Doudoune Femme Pas Cher

Michael Kors handbag on sale

canada goose sale online

Negozi Pandora

Doudoune Moncler Solde

Adidas Superstar

Ugg Grise Pas Cher

Soccer Boots Outlet nike

uggs for women

Doudoune Moncler Pas Cher

Canada Goose Outlet

official NHL jerseys

scarpe nike

pandora outlet store

Michael Kors Outlet

Nike Air Sneakers

moncler jacket sale

michael kors bags outlet

Ugg Homme Pas cher

portafoglio michael kors

Nike Air Max Boutique

Nike Air Max Cheap

Veste Moncler Pas Cher

Cheap Michael Kors

Anelli Pandora

Nike Pas Cher Homme

Bottes Ugg Pas Cher

Soldes Ugg

Air Max Femme

Air Max For Sale

moncler girls

nike schuhe günstig

Canada Goose Coats For Men

nike damenschuhe

Michael Kors Handbags Discount

cheap air max outlet

Stone Island Outlet

adidas outlet

Original Ugg Boots

religion store

Oakley Sunglasses Cheap

christian louboutin outlet

chaussures de foot pas cher

adidas outlet stores online

Air Jordan News

cheap nike air max

Sheepskin Ugg Boots

adidas kläder

nike sportschuhe damen

michael kors handbags on sale

Chaussure Nike Pas Cher

chaussure Nike homme

Air Jordan Release Date

Timberland skor

Coach Bags On Sale

Air Huarache

ugg store

Pandora Official Website

abercrombie and fitch store

longchamp bags on sale

botas de futbol

womens nike air max

nike tn pas cher

Canada Goose Sale Outlet

Moncler Jacket Womens

Lebron 13

converse store

zapatos de futbol nike

Orecchini Pandora

Toms Shoes For Women

Michael Kors handbag discount

Jordan Store

Boty Nike Air

uggs outlet

adidas store

Chestnut Ugg Boots

moncler coats for women

Uggs Pas Cher Soldes

Chaussure Nike Air Max Pas Cher

Canada Goose Outlet

Nike Pas Cher Femme

Doudoune Moncler Site Officiel

toms shoes outlet

pandora bracelet charms

nfl store

chaussures nike pas cher

nike air

nike free

canada goose jackets on sale

Pandora Beads And Charms

cheap uggs

Nike Air Max 90

ugg factory outlet

sac a main michael kors

nike sportschuhe

newest lebron shoes

zapatilla adidas

Uggs Outlet Store

adidas schoenen

pandora rings

ugg boots for women

Ray ban sale online

prada outlet

canada goose jackets for women

huarache sneakers

pandora online

nike shoes

Botte Ugg Femme

new pandora charms

pandora charm bracelet sale

canada goose online store

Nike Store

Ugg boots Sale

Bottes Ugg Femme Pas Cher

Sneakers Nike

vans shoe store

tru religion jeans

Moncler Outlet Online

cheap real uggs

cheap christian louboutin

coach factory outlet online

uggs for cheap

Ugg Outlet Online Store

nike chaussures

nike air max running shoes

Ugg Pas Cher Femme

Ugg Boots On Clearance

Pandora Store

ugg clearance

Nike Factory Store

ugg boots outlet online

ray ban wayfarer eyeglasses

goedkope nike air max

hhcg 12.23






Excel


Sdílejte

Pomohl Vám návod?
Sdílejte na Facebooku, G+
LinkedIn...

Nové články


Reklama


TOPlist Licence Creative Commons webarchiv rss XML

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 - 2024 |