PC-HELP.CZ

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 )
Předem všem moc děkuji za jakoukoliv radu

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)

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 .
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 .
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.

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.

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í.

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

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