< návrat zpět

MS Excel


Téma: Makro pro sadu CheckBox s podmínkami rss

Zaslal/a 2.11.2023 10:38

Prosím o pomoc se sestavením makra.
Ve zjednodušeném modelovém příkladu (viz příloha) je na listu pevný počet 10 ovládacích prvků ActiveX typu CheckBox. Každý z prvků je propojen (LinkedCell) s buňkou, nad kterou je umístěn – jde o buňky v oblasti C2:C11. List má být uživatelský formulář, na kterém se odehrává řada výpočtů na základě vyplněných údajů.
Potřeboval bych dát dohromady makro, které by dokázalo ošetřit tyto zaškrtávací políčka. Mělo by plnit násl. požadavky.

1. v řádku „x“ bude CheckBox na listu viditelný pouze za splnění podmínky:JE.ČISLO(Ax)2. v řádku „x“ bude umožněno CheckBox zaškrtnout pouze za splnění podmínky:A(JE.ČISLO(Bx);Bx>=hodnmin;NE(JE.ČISLO(Cx)))3. při nesplnění podmínek dle bodu 1. a 2. musí být CheckBox nezaškrtnutý.

Poznámky:

- Uváděné „x“ v adresách buněk ve vzorcích výše, definujících podmínky, značí číslo příslušného řádku v analyzovaném rozsahu 2 až 11.

- Ve vzorci výše použitý výraz „hodnmin“ je definovaný název buňky s číselnou hodnotou na listu s názvem „Vstup“ v témže sešitě, ze kterého jsou v reálném formuláři načítány i další hodnoty do listů s formulářem (v přiloženém příkladu nazvané „Form(1)“, „Form(2) atd.), a to prostřednictvím v nich obsažených vzorců.
V sešitě je „n“ listů s identickým formulářem (liší se jen svým názvem), u kterých musí makro fungovat. Počet listů „n“ může být různý (list může být uživatelem smazán nebo také může být kopírováním vytvořen další).
List „Vstup“ musí zůstat zachovaný.

- Zdánlivě prázdné buňky v listech s formulářem obsahují záměrně prázdný znak („“), který vrací vzorce (stejně jako hodnoty v ostatních buňkách ve skutečném formuláři, v modelu jsem je pro jednoduchost vyplnil přímo hodnotami).

- Ve sloupci "F" je pro názornost funkční, ale neplnohodnotné alternativní řešení bez ovládacích prvků a maker, jak požaduji ve sloupci "C".

Příloha: zip55606_checkbox-strav-model.zip (50kB, staženo 4x)
Zaslat odpověď >

#055618
avatar
Ty podmínky jak jsi je sepsal jsou divné, ale je to jak jsem tomu porozuměl. Šak si to ve VBA upravíš podle potřeby.
Příloha: zip55618_checkbox-strav-model.zip (101kB, staženo 5x)
citovat
#055621
avatar

Milan-158 napsal/a:

Ty podmínky jak jsi je sepsal jsou divné, ale je to jak jsem tomu porozuměl. Šak si to ve VBA upravíš podle potřeby.Příloha: 55618_checkbox-strav-model.zip (101kB, staženo 2x)

Díky za řešení, ale nefunguje, jak bych potřeboval. Nevím jakou mají mít funkci ta 2 nová tlačítka. Ty jsou ve finále stejně nežádoucí.
Možná došlo k nepochopení, že jsem to nepopsal zcela srozumitelně. Podmínky, že se ti zdají divné, to je docela možné, když je ten model pro jednoduchost vytržen z kontextu. Ale pro požadovanou funkčnost jsou tam, myslím, všechny potřebné informace.
Tak, jak jsem ty vzorové 3 formuláře předvyplnil, tak to odpovídá stavu splnění těch podmínek. Tedy až na jednu výjimku, a to u form(1), kde nemá být viditelný CheckBox10 na řádku 11.citovat
#055664
avatar
Tak jsem na základě posbíraných poznatků záměr poněkud přehodnotil, a to v tom smyslu, že upouštím od použití prvku CheckBox v listu. Náhradou by mělo být použití znaku zatržítka, jak je v přiložené ukázce. Makro jsem nevymyslel ale našel a implementoval. Potřeboval bych to ale ještě doupravit, viz popis přímo ve vzorovém sešitě. Pomůže mi s tím prosím někdo?
Příloha: zip55664_checkbox-strav-model_1.zip (42kB, staženo 2x)
citovat
#055667
elninoslov
Do modulu ThisWorkbook
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Sh.Name <> "Vstup" Then
Dim Bunka As Range, Riadok(), bPodmienka As Boolean

On Error Resume Next
Set Bunka = Intersect(Target, Sh.Range("C2:C11")).Cells(1)
If Err.Number = 0 Then
Cancel = True
Application.EnableEvents = False
If Bunka = ChrW(10004) Then
Bunka = ""
Else
Riadok = Bunka.Offset(0, -2).Resize(, 4).Value
bPodmienka = (Not IsEmpty(Riadok(1, 1)) And IsNumeric(Riadok(1, 1))) And (Not IsEmpty(Riadok(1, 2)) And IsNumeric(Riadok(1, 2))) And Riadok(1, 2) >= Range("hodnmin") And (Not IsNumeric(Riadok(1, 4)) Or IsEmpty(Riadok(1, 4)))
Bunka = IIf(bPodmienka, ChrW(10004), "")
End If
Application.EnableEvents = True
End If
End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Vstup" Then
Dim Zmena As Range, ARE As Range, OK As Range, NOK As Range, Riadky(), r As Long, hodnmin As Double

Set Zmena = Intersect(Target, Sh.Range("A2:B11,D2:D11"))

If Not Zmena Is Nothing Then
Set Zmena = Intersect(Zmena.EntireRow, Sh.Range("A2:D11"))
hodnmin = Range("hodnmin")

For Each ARE In Zmena.Areas
Riadky = ARE.Value
For r = 1 To UBound(Riadky, 1)
If Riadky(r, 3) <> "" Then
Select Case (Not IsEmpty(Riadky(1, 1)) And IsNumeric(Riadky(1, 1))) And (Not IsEmpty(Riadky(1, 2)) And IsNumeric(Riadky(1, 2))) And Riadky(r, 2) >= hodnmin And (Not IsNumeric(Riadky(r, 4)) Or IsEmpty(Riadky(1, 4)))
Case True: If OK Is Nothing Then Set OK = ARE.Cells(r, 3) Else Set OK = Union(OK, ARE.Cells(r, 3))
Case False: If NOK Is Nothing Then Set NOK = ARE.Cells(r, 3) Else Set NOK = Union(NOK, ARE.Cells(r, 3))
End Select
End If
Next r
Next ARE

Application.EnableEvents = False
If Not OK Is Nothing Then OK.Value = ChrW(10004)
If Not NOK Is Nothing Then NOK.Value = ""
Application.EnableEvents = True
End If
End If
End Sub

EDIT:
Pridal som aj reakciu na to, ak zmeníte A/B na nečíslo alebo D na číslo, prípadne zmažete - fajka zareaguje. Lebo môžete urobiť zmenu dát, ktoré stáli predtým za schválením fajky...
Příloha: zip55667_checkbox-strav-model_1.zip (59kB, staženo 2x)
citovat
#055672
avatar
To: elninoslov
Funkčnost perfektní, přesně, jak potřebuji. I to ošetření a reakce na změny ve sloupcích A, B a D. Moc děkuji.

Snažil jsem se do kódu proniknout a zorientovat se, což se mi podařilo jen z menší části. Připsal jsem komentáře k jednotlivým krokům, ale často jen spíš teoreticky, funkční stránka mi poněkud uniká, a na konci jsem se zcela ztratil 4 ...

Z testování vzešlo několik postřehů.
Stojí za to ještě ošetřit případ, kdy se uživatel pokusí do buňky ve sloupci C, ve které podmínky splněny nejsou, fajku vložit ze schránky (Ctrl C, Ctrl V).
Dále, jak zabránit, aby uživatel nepřejmenoval/nesmazal list "Vstup". Podotýkám, že musí být viditelný.

Mohl bych poprosit ještě o rozchození toho CommandButton pro hromadné vyplnění fajek (v celém rozsahu C2:C11, při respektování splnění těch nadefinovaných podmínek)? Na vysvětlenou, kromě uvedených podmínek existují další nepodchytitelné podmínky, které musí nad rámec vytvořeného makra zohlednit uživatel. Proto i ta možnost nastavení každé buňky samostatně.
Příloha: zip55672_55667_checkbox-strav-model_1-1.zip (55kB, staženo 2x)
citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Vynásobit hodnoty kurzem - Power Query

Alfan • 26.4. 7:56

Relativní cesta - zdroje Power Query

Alfan • 26.4. 7:54

Vynásobit hodnoty kurzem - Power Query

elninoslov • 26.4. 7:54

Vynásobit hodnoty kurzem - Power Query

lubo • 25.4. 19:18

Relativní cesta - zdroje Power Query

elninoslov • 25.4. 15:12

Relativní cesta - zdroje Power Query

Alfan • 25.4. 15:08

Relativní cesta - zdroje Power Query

elninoslov • 25.4. 14:21