vba excel tüm hücreleri kilitler

Question

Birkaç vba alt yordamı içeren bir woorkbook'um var. Bu rutinlerden biri, kullanıcı bir onay kutusunu işaretledikten sonra bir çalışma sayfasına değişiklikler yapar. Sorun şu ki, kod çalıştırıldıktan sonra, Biçim hücreleri -> Koruma menüsünde kilitlenecek şekilde işaretlenmemiş olsa bile tüm hücreler kilitlenir. Ancak VBE'yi getirir ve msgbox Aralığı'nı ("C24") çalıştırırsam Kilitli, kilitli hücreler tekrar düzenlenebilir.

kodu aşağıdaki gibidir: Bu olamaz olmalı ve kullanıcı her zaman MsgBox kesmek whithout kilidi hücreleri düzenleyebilir gerekir

Sub cbAcertos_Click() 

Dim ws As Worksheet 
Set ws = ThisWorkbook.Worksheets("Formulário") 

Call unProtectWindow 

If Me.cbAcrescimo Then 
'Caso tenhamos acrescentado o valor de acréscimo por refeição do AEV 
    If Me.cbAcertos Then 
    'E seja necessário efectuar algum acerto 
     Application.ScreenUpdating = False 
     'Desligamos a actualização do ecrã 
     With Range("F30") 
      .ClearContents 
      .Value = "Valor Acertos:" 
      .Borders.LineStyle = xlNone 
     End With 
     'Inserimos as etiquetas de texto 
     With Range("G30") 
      .Formula = "" 
      .NumberFormat = "$#,##0.00;[Red]$#,##0.00" 
      .Borders.LineStyle = xlNone 
     End With 
     'Preparamos a célula que receberá o valor do acerto 
     With Range("F31") 
      .Value = "Sub-Total:" 
      .Borders.LineStyle = xlNone 
     End With 
     'Mais uma etiqueta 
     With Range("G31") 
      .Formula = "=G29+G30" 
      .FormulaHidden = True 
      .Borders.LineStyle = xlNone 
     End With 
     'Preparamos a célula que efectua o cálculo da soma dos valores 
     'com o valor de acerto a efectuar 
     With Range("F32") 
      .Value = "Total (IVA):" 
      .Borders(xlEdgeTop).LineStyle = xlDouble 
      .Borders(xlEdgeTop).ColorIndex = 1 
     End With 
     'Etiqueta da célula com o total 
     'acrescido de IVA 
     With Range("G32") 
      .Formula = "=IF(Escola=""Dr. João Rocha - Pai"", G31, G31*1.23)" 
      .FormulaHidden = True 
      .NumberFormat = "$#,##0.00;[Red]$#,##0.00" 
      .Borders(xlEdgeTop).LineStyle = xlDouble 
      .Borders(xlEdgeTop).ColorIndex = 1 
     End With 
     'Preparamos a célula que efectua 
     'o cálculo do valor acrescido de IVA 
     Application.ScreenUpdating = True 
     'Activamos a actualização do ecrã 
    ElseIf Not Me.cbAcertos Then 
    'Caso não tenhamos de efectuar acertos 
     Application.ScreenUpdating = False 
     'Desligamos a actualização do ecrã 
     With Range("F30") 
      .Value = "Total (IVA):" 
      .Borders(xlEdgeTop).LineStyle = xlDouble 
      .Borders(xlEdgeTop).ColorIndex = 1 
     End With 
     'Preparamos a etiqueta do total 
     'acrescido de IVA 
     With Range("F31") 
      .ClearContents 
     End With 
     'Limpeza de células não actualizadas 
     With Range("G30") 
      .Formula = "=IF(Escola=""Dr. João Rocha - Pai"", G29, G29*1.23)" 
      .Borders(xlEdgeTop).LineStyle = xlDouble 
      .Borders(xlEdgeTop).ColorIndex = 1 
     End With 
     'Preparamos a célula que efectua, agora, 
     'o cálculo do total acrescido de IVA 
     With Range("G31") 
      .Formula = "" 
     End With 
     'Mais limpezas 
     With Range("F32") 
      .Value = "" 
      .Borders.LineStyle = xlNone 
     End With 
     With Range("G32") 
      .Formula = "" 
      .FormulaHidden = False 
      .NumberFormat = xlNone 
      .Borders.LineStyle = xlNone 
     End With 
     Application.ScreenUpdating = True 
    End If 
Else 
'Caso não tenhamos de acrescentar o acréscimo do AEV 
    If Me.cbAcertos Then 
     'Desligamos a actualização do ecrã 
     Application.ScreenUpdating = False 
     'Acrescentamos o texto 
     With Range("F28") 
      .Value = "Valor Acerto:" 
     End With 
     'Limpamos e desbloqueamos a célula que recebe o valor do acerto 
     With Range("G28") 
      .ClearContents 
     End With 
     'Acrescentamos a célula que recebe a soma 
     'entre o valor das refeições e o valor do acerto 
     With Range("F29") 
      .Value = "Sub-Total:" 
      .FormulaHidden = True 
     End With 
     With Range("G29") 
      .Formula = "=G27+G28" 
     End With 
     'Acrescentamos a célula que recebe o valor total 
     'acrescido de IVA 
     With Range("F30") 
      .Font.Size = 10 
      .Font.Bold = True 
      .HorizontalAlignment = xlRight 
      .VerticalAlignment = xlCenter 
      .Value = "Total (IVA):" 
     End With 
     'Acrescentamos o cálculo do IVA caso 
     'não sejam refeições do AEV 
     With Range("G30") 
      .FormulaHidden = True 
      .Font.Size = 10 
      .Formula = "=IF(Escola=""Dr. João Rocha - Pai"", G29, G29*1.23)" 
      .NumberFormat = "$#,##0.00;[Red]$#,##0.00" 
     End With 
     'Acrescentamos a border dupla para indicar a soma 
     Range("F30:G30").Borders(xlEdgeTop).LineStyle = xlDouble 
     Range("F30:G30").Borders(xlEdgeTop).ColorIndex = 1 
     'Activamos a actualização do ecrã 
     Application.ScreenUpdating = True 
     MsgBox Range("C24").Locked 
    ElseIf Not Me.cbAcertos Then 
    'Caso não existam acertos desactivamos o ecrã 
     Application.ScreenUpdating = False 
     'Alteramos o conteúdo da célula para indicar 
     'o total acrescido de IVA 
     With Range("F28") 
      .Value = "Total (IVA):" 
     End With 
     'Limpamos o conteúdo nas restantes células 
     With Range("F29") 
      .ClearContents 
     End With 
     'Alteramos a formula existente 
     With Range("G28") 
      .Formula = "=IF(Escola=""Dr. João Rocha - Pai"", G27, G27*1.23)" 
     End With 
     'Mais limpezas 
     With Range("G29") 
      .Formula = "" 
     End With 
     With Range("F30") 
      .ClearContents 
     End With 
     With Range("G30") 
      .Formula = "" 
     End With 
     With Range("F30:G30") 
      .Borders.LineStyle = xlNone 
     End With 
     'Activamos a actualização do ecrã 
     Application.ScreenUpdating = True 
    End If 
End If 

Call protectWindow 

End Sub 

. Kodla bir hata tespit edip düzeltmeleri önerebilecek biri var mı?

Koruma kodunuWindow ve unProtectWindow için ekliyorum. Bazı hücreler kilitlendiğinden koruma gereklidir.

Sub protectWindow() 
Dim wb As Workbook 
Dim ws As Worksheet 

Set wb = ThisWorkbook 
Set ws = wb.Worksheets("Formulário") 

wb.Protect pwd, Structure:=True, Windows:=True 
With ws 
    .Protect pwd 
    .EnableSelection = xlUnlockedCells 
End With 

End Sub 

Sub unProtectWindow() 

With ThisWorkbook 
    .Unprotect pwd 
    .Worksheets("Formulário").Unprotect pwd 
End With 

End Sub 

Bu bir hata yüzünden olabilir mi?

Answer 1

Hücrelerinizin açık kalmasını istiyorsunuz, değil mi? Eğer öyleyse, Sub'nuzun sonunda protectWindow'u çağırmamanız gerekir.

Sub UnlockingCells() 
    ActiveSheet.Range("A1:G37").Locked = False 
    ActiveSheet.Unprotect 
End Sub