Excel VBA - zamykání buněk

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

ondra.baf
nováček
Příspěvky: 7
Registrován: únor 15
Pohlaví: Nespecifikováno
Stav:
Offline

Excel VBA - zamykání buněk

Příspěvekod ondra.baf » 06 dub 2015 17:02

Cílem tohoto makra je provést uzamčení bloku buněk, pokud nastane jejich vyplnění. Před tímto krokem je v Msgbox možnost vybrat: potvrdí uzamčení nebo odstraní poslední vyplněnou hodnotu. Uzamčení by mělo probíhat po blocích C5:H6, C7:H8 až po C63:H64.
Já sem dal dohromady toto makro:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A5") = 1 Then
If Range("C5:H6").Locked = False Then
Zámek = MsgBox("Jsou odpovědi správné?", vbYesNo, "Pakračujeme?")
Select Case Zámek
Case vbNo
MsgBox ("Odpovědi nebyli správné. Byla odstraněna poslední odpověď.")
Range("H6").ClearContents
Case vbYes
MsgBox ("Pokud je vše v pořádku, tak tedy pokřačujeme.")
Range("C5:H6").Select
ActiveSheet.Unprotect
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ThisWorkbook.Save
End Select
End If
End If

If Range("A7") = 1 Then
If Range("C7:H8").Locked = False Then
Zámek = MsgBox("Jsou odpovědi správné?", vbYesNo, "Pakračujeme?")
Select Case Zámek
Case vbNo
MsgBox ("Odpovědi nebyli správné. Byla odstraněna poslední odpověď.")
Range("H8").ClearContents
Case vbYes
MsgBox ("Pokud je vše v pořádku, tak tedy pokřačujeme.")
Range("C7:H8").Select
ActiveSheet.Unprotect
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ThisWorkbook.Save
End Select
End If
End If

Atd...... až
If Range("A63") = 1 Then
If Range("C63:H64").Locked = False Then
Zámek = MsgBox("Jsou odpovědi správné?", vbYesNo, "Pakračujeme?")
Select Case Zámek
Case vbNo
MsgBox ("Odpovědi nebyli správné. Byla odstraněna poslední odpověď.")
Range("H64").ClearContents
Case vbYes
MsgBox ("Pokud je vše v pořádku, tak tedy pokřačujeme.")
Range("C63:H64").Select
ActiveSheet.Unprotect
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ThisWorkbook.Save
End Select
End If
End If
End Sub

Toto makro má tři problémy :
1. Při splnění podmínek If a následně vyberu v MsgBox ano se mi provede uzamčení a znovu se spustí uzamčení. Jak to Odstranit ?( Msgbox se spouští dvakrát tjs. dvakrát dojde k uzamčení)
2. Pokud je uzamčen první blok funkce nepokračuje sama dál při vyplnění dalších bloku v pozdějším čase.
3. Jak napsat toto makro pro všech 30 variant bez nutnosti vypisovat každou zvlášť?

Už sem zkoušel hodně variant ale problém č.1 a č.2 jsem nebyl schopen odstranit. Pokud by jej někdo vyřešit byl bych moc vděčný. Problém č.3 je píše okrajový( 30 variant není zas tak moc :geek: )
Předem všem moc děkuji za jakoukoliv radu :D
Přílohy
Pokusy.xlsm
(25.17 KiB) Staženo 23 x

Reklama
guest
Pohlaví: Nespecifikováno

Re: Excel VBA - zamykání buněk

Příspěvekod guest » 07 dub 2015 09:20

Ach jo.

Podmínky ve sloupci A jsou.. no takový nepěkná věc. Evidentně nerozlišujete prázdné a nulové buňky, neříká vám nic třeba funkce POČET2
Uživatel se ukliká k smrti...
Zamykat, odemykat, zamykat, odemykat, ...
Save, Save, Save, Save, ...
Metoda Offset vám ni neříká...
Co takhle používat zarážky a kód krokovat? Událost je SelectionChange, provádíte Select a divíte se, že to proběhne dvakrát... (EnableEvents = False a pak vracet na True), kromě toho Select je zbytečný, operace se provádí přímo na Range)

ondra.baf
nováček
Příspěvky: 7
Registrován: únor 15
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel VBA - zamykání buněk

Příspěvekod ondra.baf » 10 dub 2015 16:02

S VBA mám nulové zkušenosti. Mé vzdělání v této oblasti je v rozsahu toho, co jsem se dočetl na Internetu. Je mi jasné, že pro někoho kdo se v této oblasti vyzná musí moje kódy vypadat hrozivě, ale aspoň se o něco pokouším :D.
Funkci POČET 2 jsem doposud neznal, takže díky za radu.
Co se týče nulových buněk to řeším pomocí ověření dat 8) .
Metoda offset mi opravdu nic neříká, ale z Google jsem pochopil že by tím šlo realizovat relativní adresovaní, ale nemám tušení jak.
Zkusil jsem to pojmout trochu jinak, nicméně stále mám problém s vyvoláním MsgBox dvakrát po sobě. Další problém mám s použít nějaké inteligentní funkce, u které bych nemusel ručně vypisovat všech 30 variant.

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A5") = 13 Then
If Range("C5:H6").Locked = False Then
MsgBox "Odpovědi byly uloženy. Můžeme pokračovat." & vbCrLf & "Po dobu 15 vteřin je možné ještě upravit údaje.", 0, "A jedeme dál"
Application.OnTime Now + TimeValue("00:00:15"), "Uzamknout1"
End If
End If

If Range("A7") = 13 Then
If Range("C7:H8").Locked = False Then
MsgBox "Odpovědi byly uloženy. Můžeme pokračovat." & vbCrLf & "Po dobu 15 vteřin je možné ještě upravit údaje.", 0, "A jedeme dál"
Application.OnTime Now + TimeValue("00:00:15"), "Uzamknout2"
End If
End If
atd...

"Uzamknou" potom vypadá takto:
Sub Uzamknout1()
Range("C5:H6").Select
ActiveSheet.Unprotect
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ThisWorkbook.Save
End Sub
Sub Uzamknout2()
Range("C7:H8").Select
ActiveSheet.Unprotect
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ThisWorkbook.Save
End Sub

Do sešitu jsem vytvořil další funkci a to možnost "úpravy uzamčeného bloku" - Ta z uživatelského hlediska funguje jak má. Opět ale nevím jak ji napsat pomocí nějaké inteligentní funkce, u které bych nemusel vypisovat všech 30 variant.

Předem díky za každou radu která mi pomůže tyto makra vytvořit.
Přílohy
Pokusy.xlsm
(43 KiB) Staženo 20 x

guest
Pohlaví: Nespecifikováno

Re: Excel VBA - zamykání buněk

Příspěvekod guest » 10 dub 2015 18:07

Jedno po druhém. Zkuste si zatím nastudovat funkci listu POSUN. To, co umí ve druhém a a třetím parametru, řeší metoda Offset ve VBA, to, co dělá ve čtvrtém a pátém parametru, umí ve VBA metoda Resize. Mohlo by vám to spolu s cyklem pomoct právě pro těch 30 ručně vypisovaných variant.

ondra.baf
nováček
Příspěvky: 7
Registrován: únor 15
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel VBA - zamykání buněk

Příspěvekod ondra.baf » 12 dub 2015 01:39

Tak se jsem trochu pokročil:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MojeRange As Range
Dim i As Integer
For i = 5 To 63 Step 2
Set MojeRange = Cells(i, 1)
If MojeRange = 13 Then
If MojeRange.Offset(0, 2).Resize(2, 6).Locked = False Then
MsgBox "Odpovědi byly uloženy. Můžeme pokračovat k další ochutnávce." & vbCrLf & "Po dobu 15 vteřin je možné ještě upravit údaje.", 0, "A jedeme dál"
Application.OnTime Now + TimeValue("00:00:15"), "Uzamknout"
End If
End If
Next i
End Sub

Sub Uzamknout ()
MojeRange.Offset(0, 2).Resize(2, 6).Locked.Select - "Jak nadefinovat MojeRange ?"
ActiveSheet.Unprotect
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ThisWorkbook.Save
End Sub
Už to vypadá mnohem lépe, ale nepřišel jsem na to jak definovat Moje.Range, nebo jak jinak docílit zpoždění spuštění uzamčení.

guest
Pohlaví: Nespecifikováno

Re: Excel VBA - zamykání buněk

Příspěvekod guest » 12 dub 2015 18:12

Nevím, jestli jsem pochopil, ale na dotčenou oblast v událostní proceduře se odkazujeme přes Target...

ondra.baf
nováček
Příspěvky: 7
Registrován: únor 15
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel VBA - zamykání buněk

Příspěvekod ondra.baf » 13 dub 2015 22:37

Dík moc už to vše funguje jak má.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Tisk z excelu mění výšky buněk
    od Moonddur » 28 dub 2023 11:50 » v Kancelářské balíky
    1
    1653
    od atari Zobrazit poslední příspěvek
    28 dub 2023 12:08
  • Excel a OneDrive
    od sginfo » 11 zář 2023 15:28 » v Kancelářské balíky
    16
    5985
    od mirekol Zobrazit poslední příspěvek
    20 říj 2023 08:31
  • excel-posun makra
    od actionboy » 12 bře 2024 18:59 » v Kancelářské balíky
    1
    260
    od Grimm Zobrazit poslední příspěvek
    12 bře 2024 21:43
  • Excel - vlastní formát Příloha(y)
    od Story-Long » 11 srp 2023 14:50 » v Kancelářské balíky
    3
    1837
    od Story-Long Zobrazit poslední příspěvek
    14 srp 2023 10:11
  • Excel - funkce když
    od Martyn20 » 13 črc 2023 11:56 » v Kancelářské balíky
    5
    2317
    od mmmartin Zobrazit poslední příspěvek
    13 črc 2023 18:44

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 6 hostů