0
desfazer
Votos
Estou montando uma planilha para dados de tendências para testes analíticos de produtos químicos. Eu gostaria que cada linha de dados fosse bloqueada assim que a transcrição desses dados fosse verificada pelo revisor. Eu sou capaz de bloquear uma única linha usando este código no VBA:
Private Sub Worksheet_Change (ByVal Target As Range)
Se Range("X3") = "Não" Então
Range("B3:W3").Bloqueado = False
ElseIf Range("X3") = "Sim" Then
Range("B3:W3").Bloqueado = Verdadeiro
Se acabar
End Sub
A coluna X contém uma lista suspensa com "Sim" e "Não" como as duas opções. Gostaria que cada linha de dados, à medida que fosse adicionada à planilha, fosse bloqueada assim que o revisor selecionar sim nesta coluna para garantir que nenhuma alteração não intencional seja feita nos dados anteriores. Isso é possível sem ter que repetir o código sobre para cada linha indefinidamente?
Private Sub Worksheet_Change (ByVal Target As Range)
Se Range("X3") = "Não" Então
Range("B3:W3").Bloqueado = False
ElseIf Range("X3") = "Sim" Then
Range("B3:W3").Bloqueado = Verdadeiro
Se acabar
End Sub
A coluna X contém uma lista suspensa com "Sim" e "Não" como as duas opções. Gostaria que cada linha de dados, à medida que fosse adicionada à planilha, fosse bloqueada assim que o revisor selecionar sim nesta coluna para garantir que nenhuma alteração não intencional seja feita nos dados anteriores. Isso é possível sem ter que repetir o código sobre para cada linha indefinidamente?
Resposta Aceita
1
desfazer
Votos
Olá StephanieS,
Por favor, tente o código abaixo, se você tiver mais alguma dúvida, não hesite em me perguntar.
Amanda
Por favor, tente o código abaixo, se você tiver mais alguma dúvida, não hesite em me perguntar.
Amanda
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPassword As String
Dim xRgAddress As String
Dim xLockRgAddress As String
Dim Row As Integer
xPassword = "123456" 'Please replace 123456 with the password that protects the spreadsheet.
On Error Resume Next
If (Target.Column <> 24) Then
Exit Sub
End If
Row = Target.Row
If Target = "Yes" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
ElseIf Target = "No" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
End Sub
0
desfazer
Votos
Também preciso que seja capaz de alterar o status dessas células de desbloqueadas para bloqueadas enquanto a planilha estiver protegida, caso contrário, esse recurso é inútil.
Resposta Aceita
1
desfazer
Votos
Olá StephanieS,
Por favor, tente o código abaixo, se você tiver mais alguma dúvida, não hesite em me perguntar.
Amanda
Por favor, tente o código abaixo, se você tiver mais alguma dúvida, não hesite em me perguntar.
Amanda
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPassword As String
Dim xRgAddress As String
Dim xLockRgAddress As String
Dim Row As Integer
xPassword = "123456" 'Please replace 123456 with the password that protects the spreadsheet.
On Error Resume Next
If (Target.Column <> 24) Then
Exit Sub
End If
Row = Target.Row
If Target = "Yes" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
ElseIf Target = "No" Then
If ActiveSheet.Range("B" & Row & ":W" & Row).Locked = True Then
ActiveSheet.Unprotect (xPassword)
ActiveSheet.Range("B" & Row & ":W" & Row).Locked = False
ActiveSheet.Protect Password:=xPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
End Sub
0
desfazer
Votos
Muito obrigado! Esse código funcionou perfeitamente. Eu ainda sou muito novo no VBA, então eu realmente aprecio sua ajuda! 
- Página :
- 1
Ainda não há respostas para esta postagem.