• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Makro účinné podľa pozície tlačítka

Zaslal/a Zdeno-Frano 8.9.2018 19:07

Dobrý večer.
Poprosím o radu. Mám makro na doplnenie, resp. vymazanie časti textu v bunke, ktoré spúšťam tlačítkom formulára. Je pridelené konkrétnej bunke. Takýchto buniek však mám viac v ďalších riadkoch, v každom riadku je tlačítko. Dá sa upraviť to makro tak, aby som ho nemusel písať pre každé tlačítko, teda riadok zvlášť, ale aby fungovalo na konkrétny riadok podľa pozície tlačítka?
Sub Služobná_cesta_2()
If InStr(Range("A2").Value, "služobná cesta - ") > 0 Then
Range("A2").Value = Replace(Range("A2"), "služobná cesta - ", "")
Exit Sub
Else
Range("A2").Value = "služobná cesta - " & Range("A2").Value
End If
End Sub
Nejde to podľa aktívnej bunky, lebo má fungovať aj na bunky, ktoré aktívne nie sú.
Ďakujem vopred

Příloha: 41433_pridanie_vymaz_textu_makro.zip (16kB, staženo 28x)

Zaslat odpověď >

---

Pavlus(8.9.2018 22:15)#041434

Napadá mě řešení bez tlačítek, přes událost listu - například přes BeforeDoubleClick nebo BeforeRightClick. Jinými slovy makro spouštět dvojklikem myši (resp. kliknutím pravého tlačítka myši) do příslušné buňky "řídícího" sloupce.
P.

Událost listu:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column = 2 And Target.Row > 1 Then
Call Služobná_cesta(Target.Row)
Cancel = True
End If

End Sub
Makro v Modulu:
Sub Služobná_cesta(radek)

If InStr(Cells(radek, 1).Value, "služobná cesta - ") > 0 Then
Cells(radek, 1).Value = Replace(Cells(radek, 1), "služobná cesta - ", "")
Exit Sub
Else
Cells(radek, 1).Value = "služobná cesta - " & Cells(radek, 1).Value
End If

End Sub
Viz také příloha:

Příloha: 41434_pridanie_vymaz_textu_makro_reseni.zip (14kB, staženo 39x)

citovat

Zdeno-Frano(8.9.2018 22:33)#041435

Skúšam stiahnuť prílohu, ale akosi mi to nejde:-). Píše mi, že: Vámi požádovaná stránka nebyla nalezena.
Môžem poprosiť znovu o prílohu?
Ďakujemcitovat

Zdeno-Frano(8.9.2018 23:11)#041436

Už sa mi to podarilo spustiť.
Ďakujem, idem sa s tým pohrať :-)citovat

eLCHa(9.9.2018 12:05)#041440

1) Rada - Nepoužívejte v názvech procedur, proměnných atp diakritiku
2) Tyto věci řeším jedním tlačítkem a v proceduře odkazem na aktuální polohu kurzoru
3) Když už byste na tom trval, tak ano - toto lze udělat - všem tlačítkům přiřaďte 1 proceduruSub Sluzobna_cesta()
Dim rCell As Range
Set rCell = ActiveSheet.Cells(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row, 1)
If InStr(rCell.Value, "služobná cesta - ") > 0 Then
rCell.Value = Replace(rCell.Value, "služobná cesta - ", "")
Else
rCell.Value = "služobná cesta - " & rCell.Value
End If
Set rCell = Nothing
End SubPak už záleží pouze na správném umístění tlačítka.citovat

Zdeno-Frano(9.9.2018 12:15)#041441

Super, ďakujem moc, večer vyskúšam, teraz musím makať rukami :-)citovat

Zdeno-Frano(9.9.2018 22:32)#041444

Pre eLCHa:
Ďakujem. Presne tak som to potreboval.

Ďakujem aj Pavlusovi. Aj to riešenie je OK, len trošku náročnejšie na vysvetlenie pre iných používateľov.

Pekný večercitovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse