MS Excel

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

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: zip

41434_pridanie_vymaz_textu_makro_reseni.zip (14kB, staženo 41x)

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

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

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje