Excel VBA - zamykání buněk
Napsal: 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 )
Předem všem moc děkuji za jakoukoliv radu
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