< návrat zpět

MS Excel


Téma: VBA zamkne buňku po zadání hodnoty rss

Zaslal/a 12.1.2018 13:02

Ahoj.
Potřeboval bych vyřešit automaticé uzamykání buňky/buněk v dané oblasti jednoho nebo více listů, po zadání hodnoty do buňky/buněk. Nejlépe však po uložení/uzavření souboru z důvodu případné opravy hodnoty v buňce před uložení souboru.
Nějaká řešení jsem na webu našel, ale né všechna fungují nebo né zcela řeší můj problém. Umím s VBA pacovat pouze formou záznamu makra. 7 Používám MS Excel 10 a vyšší.
Děkuji.

Zaslat odpověď >

#039016
avatar
Pokud jsem správně pochopil požadavek, měla by ho splnit následující událostní procedura, umístěná v objektu ThisWorkbook:
Private Sub Workbook_Open()
With Sheets("Chráněný List")
.Unprotect Password:="Heslo"
With .UsedRange
.Locked = False
.SpecialCells(xlCellTypeConstants).Locked = True
.SpecialCells(xlCellTypeFormulas).Locked = True
End With
.Protect Password:="Heslo"
End With
End Sub
Literály Chráněný list a Heslo je nutno nahradit skutečným jménem listu a vlastním heslem.citovat
#039027
avatar
Supr, moc díky. Zkusím. 1citovat
#039028
avatar
Otestováno a.... 4
Hází mi to chybu při otevření souboru

"Run-time error 1004"
Nebyly nalezeny žádné buňky.

Zastaví se to na 7. řádku
.SpecialCells(xlCellTypeFormulas).Locked = True

Zkusil jsem to v odemknutém listu, pak jsem odemkl pole buněk a zamkl list na dané heslo. Nic
Stále to hází chybu. 7

Na webu jsem našel následující:

Potřeboval bych makro , které by pracovalo asi takto.
V listu1 budu mít tabulku , do které budou různí uživatelé vyplňovat různá data (převážně čísla).
Potřebuji aby se tabulka nebo raději celý list automaticky zamykal a to tím způsobem, že po vyplnění volných polí
a zavření sešitu (uložení) se automaticky uzamknou vepsaná data a volné buňky zůstanou odemčeny pro další vložení dat dalším uživatelem odemčeny.
Jednoduše postupně se budou po uložení zamykat všechny neprázdné buňky v listu1, tak aby zapsaná data nešly následně změnit.
Půjde to nějak řešit ....pomůžete?
Děkuji.
_______________________________________________
To makro by nebyl problém. Pro jeho naprogramování doporučuji makrokameru. Pro spuštění doporučuji umístit tlačítko s textem například "Zapsat uložit a zavřít"

Pozadovane lze resit takto:
Na prislusnem listu (list1) zrusit uzamceni bunek v pozadovane oblasti (napr.: A1:E20 a G1:G20).
V editoru VBA (Alt+F11) vlozit procedury:
do modulu Tento_sesit - heslo je "password" (bez uvozovek) - zmenit, heslo neni podminku, lze pripadne vynechat:

Option Explicit

Private Sub Workbook_Open()
Worksheets("list1").Protect Password:="password",
UserInterfaceOnly:=True
End Sub

a do modulu prislusneho listu - list1:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Target.Resize(1, 1)
If Not Intersect(Me.Range("a1:e20,g1:g20"), Target) Is
Nothing Then
Target.Locked = True
End If
End Sub

Po zapisu do bunky v pozadovane oblasti bude bunka uzamknuta.

Toto je přesně co potřebuji a funguje bez chyby, ovšem nevýhoda je nemožnost opravy zadaných dat před uložením souboru.

Následuje úprava:

Tazatel se k moznemu reseni zatim nevyjadril, ale lze i takto:
Namisto procedury Worksheet_Change v modulu listu vlozit pro drive zminenou oblast bunek na listu1 do modulu Tento_sesit napriklad tuto proceduru:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim BlkL As Range, Cll As Range
Set BlkL = Worksheets("list1").Range("a1:e20,g1:g20")
For Each Cll In BlkL.Cells
If Cll.Value vbNullString Then Cll.Locked = True
Next Cll
Set Cll = Nothing
Set BlkL = Nothing
End Sub

a bude uzamykat bunky pri zavirani sesitu.

Smazal jsem tedy makro v modulu listu a do modulu ThisWorkbook jsem zkopíroval inovaci.
Výsledek je opět chyba. 7

Tak nevím, co dělám špatněcitovat
#039029
avatar
Už jsem na to přišel. 2
Sekalo se to, protože jsem to zkoušel v čistém listu bez vzorců. Doplnil jsem buňku se vzorcem a funguje to.

Ale problém vyvstal jinde. V listu používám ovládací prvek "číselník", a buňka se kterou je provázán, musí zůstat odemknutá.
1.Nešlo by to upravit jen pro předem definovanou skupinu buněk? Třeba b2:f20, tak aby zbytek listu zůstal odemčený nebo zamčený jak budu potřebovat?
2.Pokud budu chtít takto uzamykat více listů, stačí pod

With Sheets("Chráněný List")

dopsat další listy?

With Sheets("List1")
With Sheets("List2")
atd.citovat
#039032
avatar
No akosi nestíham sledovať tvoje myšlienkové pochody.

Vo Vovkovom makre nahraď
With .UsedRange
za
With .Range("B2:F20")

A to s viacerými listami asi nebude tak jednoduché ako si možno ty myslíš. Zrejme to musíš dať do cyklu.citovat
#039033
avatar
Tak více listů jsem vyřešil namnožením sekvence

With Sheets("Chráněný List")
.Unprotect Password:="Heslo"
With .UsedRange
.Locked = False
.SpecialCells(xlCellTypeConstants).Locked = True
.SpecialCells(xlCellTypeFormulas).Locked = True
End With
.Protect Password:="Heslo"
End With

...s různými listy 1

Teď už jen vyřešit aby to uzamykání fungovalo jen pro danou oblast buněk a bude to perfektní.
Díky 10citovat
#039034
avatar
Super 'marjankaj'
Díky za radu, odzkouším a dám vědět. 1
Ale věřím, že to bude fungovat. 10citovat
#039035
avatar
Odzkoušeno.
Vše funguje jak má, dle mých představ.
Díky chlapi. 10

Finální makro tedy vypadá po mých úpravách takto:
___________________________________________
Private Sub Workbook_Open()

' ŠO-1
With Sheets("ŠO-1")
.Unprotect Password:="123"
'With .UsedRange
With .Range("c4:d600,g4:i600,k4:k600")
.Locked = False
.SpecialCells(xlCellTypeConstants).Locked = True
'.SpecialCells(xlCellTypeFormulas).Locked = True
End With
.Protect Password:="123"
End With

' ŠF-2
With Sheets("ŠF-2")
.Unprotect Password:="123"
'With .UsedRange
With .Range("c4:d600,g4:i600,k4:k600")
.Locked = False
.SpecialCells(xlCellTypeConstants).Locked = True
'.SpecialCells(xlCellTypeFormulas).Locked = True
End With
.Protect Password:="123"
End With

' VW-3
With Sheets("VW-3")
.Unprotect Password:="123"
'With .UsedRange
With .Range("c4:d600,g4:i600,k4:k600")
.Locked = False
.SpecialCells(xlCellTypeConstants).Locked = True
'.SpecialCells(xlCellTypeFormulas).Locked = True
End With
.Protect Password:="123"
End With

End Sub
__________________________

Řádek '.SpecialCells(xlCellTypeFormulas).Locked = True
jsem zakomentoval, protože v dané oblasti se žádné vzorce nenachází a nacházet nebudou. Definované oblasti slouží pouze k zadání hodnot. Zbytek sešitu je dle potřeby uzamčen. 1

Ještě jednou moc děkujicitovat
#039036
elninoslov
Toto žiaľ nemôže byť koniec. Zabudli ste na častú možnosť, otvorenia súboru bez povolenia makier. V takomto prípade sa to rieši tak, že pri uložení sa schovajú všetky listy, len sa odkryje jeden s logom, na ktorom je napísané, aby sa makro kvôli funkcionalite zaplo, potom sa list schová a ostatné sa zobrazia.
Pri Uložení treba zase uložiť listy ako schované, a iba list s logom ostane.citovat
#039038
avatar
Pravda 'elninoslov' 7
A mohl by jste mi s tímto problémem trochu pomoci, nebo alespoň napovědět jak to vyřešit?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

Relativní cesta - zdroje Power Query

elninoslov • 23.4. 19:33

Vyhledej

elninoslov • 23.4. 18:54

Vyhledej

PavDD • 23.4. 12:29

Vyhledej

PavDD • 23.4. 11:47

Relativní cesta - zdroje Power Query

Alfan • 23.4. 10:52

Relativní cesta - zdroje Power Query

elninoslov • 23.4. 10:22

Relativní cesta - zdroje Power Query

lubo • 23.4. 10:15