Bloqueando e desbloqueando células com base no valor em outra célula para tabelas

1

Até agora, na internet, tenho visto maneiras pelas quais alguém pode bloquear células em uma planilha excel com base em outro valor de célula, no entanto, ainda estou para encontrar qualquer coisa que se relacione com casos em que essas células estão contidas em uma tabela devido para a mesa de dinamismo trazer.

Abaixo, eu tenho um código VBA adaptado para atender a minha própria aplicação, mas não funciona.

Private Sub Worksheet_Change(ByVal Target As Range)    Dim tbl As ListObject
Set tbl = Worksheets("Nursery").ListObjects("TableName")


If Not Intersect(Target, tbl.ListColumns("Bus Discount").Range) Is Nothing Then
    Dim CellBusDiscount As Range
    Unprotect Password:="Secret"

    For Each CellBusDiscount In Intersect(Target, tbl.ListColumns("Bus Discount").Range)
        Select Case CellBusDiscount.Value
            Case "Yes"
                CellBusDiscount.Offset(0, Application.Worksheet.Function.Match("Bus Reason", tbl.HeaderRowRange, 0) - Application.WorksheetFunction.Match("Bus Discount", tbl.HeaderRowRange, 0)).Locked = False
                CellBusDiscount.Offset(0, Application.Worksheet.Function.Match("Bus Discount Amt", tbl.HeaderRowRange, 0) - Application.WorksheetFunction.Match("Bus Discount", tbl.HeaderRowRange, 0)).Locked = False
            Case "No"
                CellBusDiscount.Offset(0, Application.Worksheet.Function.Match("Bus Reason", tbl.HeaderRowRange, 0) - Application.WorksheetFunction.Match("Bus Discount", tbl.HeaderRowRange, 0)).Locked = True     
                CellBusDiscount.Offset(0, Application.Worksheet.Function.Match("Bus Discount Amt", tbl.HeaderRowRange, 0) - Application.WorksheetFunction.Match("Bus Discount", tbl.HeaderRowRange, 0)).Locked = True
            Case Else
                CellBusDiscount.Offset(0, Application.Worksheet.Function.Match("Bus Reason", tbl.HeaderRowRange, 0) - Application.WorksheetFunction.Match("Bus Discount", tbl.HeaderRowRange, 0)).Locked = True     
                CellBusDiscount.Offset(0, Application.Worksheet.Function.Match("Bus Discount Amt", tbl.HeaderRowRange, 0) - Application.WorksheetFunction.Match("Bus Discount", tbl.HeaderRowRange, 0)).Locked = True
        End Select
    Next cell
    Protect Password:="Secret"
End If 
End Sub

Possíveis razões pelas quais isso não funciona;

  1. Meu conhecimento em VBA ainda é muito amador e, portanto, não consegui adaptá-lo de maneira eficaz
  2. O método Intersect usado no código pode não funcionar com tabelas.

O que estou tentando alcançar exatamente com o código acima?

Eu gostaria de ter certeza das colunas da tabela; "Bus Discount Amount" e "Bus Discount Reason" estão bloqueados se houver Não Desconto de barramento (ou seja, se o valor na coluna Bus discount for "Sim" , informe o motivo do desconto (lista suspensa) e digite o valor ou ter o valor gerado automaticamente, dependendo da seleção no "Motivo de desconto de ônibus")

Também usei a Função de planilha Match para garantir que o valor de deslocamento seja dinâmico (ou seja, se eu inserir uma nova coluna de tabela, a propriedade de bloqueio de célula permanecerá a mesma).

    
por MrMarho 23.08.2017 / 19:44

1 resposta

0

Para ativar as células de bloqueio, você deve usar a função de proteção de folhas:

Private Sub Worksheet_Change(ByVal Target As Range)    Dim tbl As ListObject
  ActiveSheet.Unprotect
  Cells.Locked = false # all cells can be edited (because excel default is Cells.Locked = true)

  #here your code where you set cells to Locked = true 
  ...
  #end of the code

  ActiveSheet.Protect
End Sub
    
por 24.08.2017 / 14:08