0
Anula
Voturi
Întocmesc o foaie de calcul pentru datele privind tendințele pentru testarea analitică a produselor chimice. Aș dori ca fiecare linie de date să fie blocată odată ce transcrierea datelor respective a fost verificată de către examinator. Pot să blochez o singură linie folosind acest cod în VBA:
Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dacă Range("X3") = "Nu", atunci
Interval ("B3:W3"). Blocat = Fals
ElseIf Range("X3") = "Da" Atunci
Interval ("B3:W3"). Blocat = Adevărat
Final, dacă
End Sub
Coloana X conține o listă derulantă cu „Da” și „Nu” drept două opțiuni. Aș dori ca fiecare rând de date, pe măsură ce este adăugată în foaie, să fie blocată odată ce recenzentul a selectat da în această coloană, pentru a mă asigura că nu se fac modificări neintenționate asupra datelor anterioare. Este posibil acest lucru fără a fi nevoie să repetați codul despre fiecare linie la nesfârșit?
Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dacă Range("X3") = "Nu", atunci
Interval ("B3:W3"). Blocat = Fals
ElseIf Range("X3") = "Da" Atunci
Interval ("B3:W3"). Blocat = Adevărat
Final, dacă
End Sub
Coloana X conține o listă derulantă cu „Da” și „Nu” drept două opțiuni. Aș dori ca fiecare rând de date, pe măsură ce este adăugată în foaie, să fie blocată odată ce recenzentul a selectat da în această coloană, pentru a mă asigura că nu se fac modificări neintenționate asupra datelor anterioare. Este posibil acest lucru fără a fi nevoie să repetați codul despre fiecare linie la nesfârșit?
Răspuns acceptat
1
Anula
Voturi
Salut StephanieS,
Vă rugăm să încercați codul de mai jos, dacă mai aveți întrebări, nu ezitați să mă întrebați.
Amanda
Vă rugăm să încercați codul de mai jos, dacă mai aveți întrebări, nu ezitați să mă întrebați.
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
Anula
Voturi
De asemenea, am nevoie de el pentru a putea schimba starea acestor celule de la deblocat la blocat în timp ce foaia de calcul este protejată, altfel această caracteristică este inutilă.
Răspuns acceptat
1
Anula
Voturi
Salut StephanieS,
Vă rugăm să încercați codul de mai jos, dacă mai aveți întrebări, nu ezitați să mă întrebați.
Amanda
Vă rugăm să încercați codul de mai jos, dacă mai aveți întrebări, nu ezitați să mă întrebați.
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
Anula
Voturi
Mulțumesc foarte mult! Codul a funcționat perfect. Sunt încă foarte nou în VBA, așa că apreciez foarte mult ajutorul tău! 
- Pagina:
- 1
Nu există răspunsuri făcute pentru acest post.