Kopírování zaškrtávacího políčka Vyřešeno

[11tom]

Přeju krásný den,
potřebuji vytvořít jednoduchý list excelu, kde bych zaznamenával vše co máme na skladu. To není problém,ale chtěl bych tam do každé řádky připojit zaškrávací tlačítko formuláře, které pří odepsání balíku vynuluje hodnotu balíku. To jsem také vyřešil. Problém je, že když chci zaškrtávací políčko kopirovat zůstane odkaz na buňku, který bych potřeboval mít na stajném řádku, zkrátka, aby se odškrtávali jednotlivé řádky. Jde to u ručně, ale sklad ve finále může mít za rok i tisíc řádků. Prosím je na toto nějaký fígl. Přípojuji soubor jak má příbližně sklad vypadat. Díky Tom

[Reklama]

[mike007]

Ahoj,

Neznám žádný fígl, ale udělal jsem ti makro, které ti checkboxy přidá a samo nastaví odkazy. Je zde jen jedna maličkost; sloupec L musí být určen pro kontrolu, zda checkbox opravdu existuje či ne. Nevím, jak to jinak udělat.
Makro vytvoří checkbox a na příslušném řádku, do sloupečku L vloží tečku. Pokud tedy příště přidáš nová data a znovu spustíš makro na doplnění checkboxů, u řádků, kde bude tečka se nový checkbox nevytvoří (už je vytvořený). Předejdeme tím možným duplicitám. Doufám, že to nebude vadit. Sloupeček L můžeš skrýt (K vlastně taky )

Nevím, jak velké máš zkušenosti s makry. Raději sem dám polopatický návod, jak makro vložit do dokumentu.

1. V Excelu; Použij klávesovou zkratku Alt+F11, kterou se dostaneš do prostředí VBA.
2. V menu VBA vyber Insert --> Module a do prázdného okna napravo nakopíruj toto makro:

Sub boxy_provedeno()
Dim radek As Long
Dim radek2 As Long
Dim ll As Double
Dim top As Double
Dim vyska As Double
Dim sirka As Double
'zjistíme, kolik řádků je použito
radek2 = Range("B65536").End(xlUp).Row
For radek = 2 To radek2
'pokud ve sloupci L chybí kontrola (v našem případě tečka), checkbox nebude na řádek přidán.
'nastaveno z důvodu možné duplicity checkboxu
If Cells(radek, "L") <> "." Then
ll = Cells(radek, "H").Left
top = Cells(radek, "H").top
vyska = Cells(radek, "H").Height
sirka = vyska = Cells(radek, "H").Width
ActiveSheet.CheckBoxes.Add(ll, top, sirka, vyska).Select
With Selection
.Caption = "Provedeno"
.Value = xlOff
.LinkedCell = "K" & radek
.Display3DShading = False
.ShapeRange.ScaleWidth 2.42, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 1.05, msoFalse, msoScaleFromMiddle
End With
'na řádku, kde byl přidán checkbox nastavíme do sloupce L kontrolu (v našem případě tečku)
Cells(radek, "L") = "."
End If
Next
End Sub

3. Prostředí VBA zavři klasicky křížkem v pravém horním rohu.
4. V Excelu; Vyber z menu Nástroje --> Makro --> Makra (případně kl. zkratka Alt+F8), označ makro "boxy_provedeno" a spusť ho pomocí tlačítka Spustit

V Příloze máš dokument i s makrem na vyzkoušení. Makro jde okamžitě spustit použitím kl. zkratky Ctrl+Shift+Q

Tak snad pomůže.

[11tom]

Ahoj mike007,

přesně něco takového jsem potřeboval, zaroveň děkuji za podrobné vysvětlení, protože s VBA nemám těměř žádné zkušenosti. Ještě jednou dík za tvůj čas.

Tom

[mike007]

jj, rádo se stalo.