Låse celler?

Følger lige med her...

Ups en lille fejl ...hver række indeholder et medicinpræparat .. ellers skulle ovenstående være korrekt. Sygeplejersken kvitterer altså for flere præparater af gangen.  vh Steen

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 35 And Target.Column = 1 Then
If Target = "hb" Then
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
ActiveSheet.Unprotect
End If
End If
End Sub

denne virker ved A35, ret selv teksten.

Klik på cellen med musen efter at der er skrevet.

Jeg er ikke sikker på at nævnte kode gør det den skal. Korriger mig hvis jeg tager fejl!
Denne beskytter eller "af"beskytter arket når det rigtige ord indtastes i en celle? Hvis det er tilfældet kan den ikke bruges.
Arket er i forvejen beskyttet. Dataområderne er ulåste. Ønsket er at når Sygepl. initialer (efter dagens arbejde) indtastes skal den kolonne hun kvitterer for (den medicin hun har givet den dag) - låses (og evt ændre farve så man kan se at cellerne (kolonne) er låste.
vh Steen

Jeg er ikke helt sikker på hvad du ønsker, Steen, men hvis du bare skal have låst cellerne (vinget låst af i formater), men ikke sat beskyttelsen til endnu, så er her et bud

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A35").EntireRow) Is Nothing Then
  Target.EntireColumn.Locked = True
End If
End Sub

denne virker på alle kolonner, men kun række 35
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 35 Then
If Target = "hb" Then
ActiveSheet.Unprotect
Target.EntireColumn.Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
End Sub

jeg er nødt til al fjerne beskyttelsen, før kolonnen låses, og så beskytte igen

Den skal virke på en hel kolonne og IKKE en hel række og der skal være mulighed for at op mod 20 sygeplejersker kan indtaste deres initialer - er det muligt? :0)

med farver

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim K As Integer
K = Target.Column
If Target.Row = 35 Then
If Target = "hb" Then
ActiveSheet.Unprotect
Target.EntireColumn.Locked = True
Worksheets("Ark1").Range(Cells(1, K), Cells(35, K)).Select
With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
End Sub

det med 20 sygeplejesker.

ja / nej

jo hvis vi siger at det skal være 3 tegn

retter vi denne her


If Target = "hb" Then
til
If len(Target) = 3 Then

den virker på kolonnen ned til række 35

Det begynder sandelig at se godt ud. Det med de 3 bogstaver er helt fint.
Lige et spørgsmål mere. Ved anvendelse af makro/vba vælger excel (2002) typisk at beskytte således at låste celler kan vælges - dette ønskes ikke!!! Kan det løses?? vh Steen

du kan vælge men ikke rette/slette

jeg har kun excel 2000

Jeg tester lige og vender hurtigt tilbage....

Det kan godt være at jeg er lidt dum - men hvor skal sygeple. indtaste de 3 initialer (det kunne ex være Row 7 række 45 - kan du rette nedenstående? vh Steen

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim K As Integer
K = Target.Column
If Target.Row = 7 Then
If Len(Target) = 3 Then
ActiveSheet.Unprotect
Target.EntireColumn.Locked = True
Worksheets("Ark1").Range(Cells(1, K), Cells(35, K)).Select
With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If
End Sub

Hvis du indsætter denne linie inden du sætter password, er det ikke muligt at vælge låste celler.

Sheets("Ark1").EnableSelection = xlUnlockedCells

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim K As Integer
K = Target.Column
If Target.Row = 7 Then
If Len(Target) = 3 Then
ActiveSheet.Unprotect
Target.EntireColumn.Locked = True
Worksheets("Ark1").Range(Cells(1, K), Cells(Target.Row , K)).Select
With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End If

det er række 7 nu
End Sub

hov fjern lige bemærkningen

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim K As Integer
K = Target.Column
If Target.Row = 7 Then
If Len(Target) = 3 Then
ActiveSheet.Unprotect Password:="kabbak"
Target.EntireColumn.Locked = True
Worksheets("Ark1").Range(Cells(1, K), Cells(Target.Row, K)).Select
With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
  Sheets("Ark1").EnableSelection = xlUnlockedCells
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="kabbak"
End If
End If
End Sub

fint bak , ny viden strømmer til mig ;-p

Nu skriver den desværre - Unable to set the locked property of the Range class OG undskyld iøvrigt det var række 44....

steensommer du er nødt til at vælge en bestemt række, dieskal underskrive i.

du retter her til den række de skal taste i.
If Target.Row = 7 Then (her er det række 7 over alle kolonner)

Jeg tror muligvis at jeg udtrykker mig lidt dårligt.
I skemaets kolonnefelt er placeret dato'er. I rækkerne de enkelte præparater. Nedenunder alle dagens præparater skal sygepl. kvittere for dagens medicinering ex de kvitterer for kolonne 4 (dato: 24-03-03) i felt d44 hvorefter kolonne d skal låses - næste dag kolonne 5 (dato: 25-03-03) i felt e44 hvorefter kolonne e skal låses. vh Steen

Prøv lige denne let modificerede makro


Private Sub Worksheet_Change(ByVal Target As Range)
Dim K As Integer
K = Target.Column
If Target.Row = 44 Then
  With ActiveSheet
      .Unprotect Password:="kabbak"
      Target.EntireColumn.Locked = True
      With .Range(Cells(1, K), Target).Interior
              .ColorIndex = 6
              .Pattern = xlSolid
      End With
      .EnableSelection = xlUnlockedCells
      .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="kabbak"
  End With
End If
End Sub

Den skriver samme fejl - kan det måske være fordi der er merged celler fra række 6 og op. Dvs at det kun er kolle c,d etc række 7 til række 44 der skal låses - undskyld!

skulle være rettet her

Private Sub Worksheet_Change(ByVal Target As Range)
Dim K As Integer
K = Target.Column
If Target.Row = 44 Then
  With ActiveSheet
      .Unprotect Password:="kabbak"
      .Range(Cells(8, K), Target).Locked = True
      With .Range(Cells(8, K), Target).Interior
              .ColorIndex = 6
              .Pattern = xlSolid
      End With
      .EnableSelection = xlUnlockedCells
      .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="kabbak"
  End With
End If
End Sub

hov ret lige
.Range(Cells(8, K), Target).Locked = True
til
.Range(Cells(7, K), Target).Locked = True

Det kan sagtens være Merged Celler for det er noget uberegnelig skidt, som jeg "aldrig" bruger. I stedet kan du marker de celler du vil have sammensat, gå til Formater / Celler /justering og sætte sætte "vandret" til centrer over markering. (Center across cells)

hej bak det er godt med lidt hjælp :-)

Hallo hvor det kører - tak til jer begge. Hva bør man måske fordele point således at kabbak får 30 og bak 20 point?

det er retfærdig synes jeg, hvad siger du bak

Mere end retfærdigt, da du jo har lavet det meste, Holger. men sammen kan vi sagtens klare det :-)

Lige en lille ting kan i huske farvekoden for lysegrå?  vh Steen

.ColorIndex = 15

Tak igen

selv tak

Jeg opretter et nyt spørgsmål vedr. låsning af hele projektmappen inkl pt ulåste celler - hvis i skulle være interesseret.  VH Steen

steensommer > du kan jo selv rette password til noget andet, men husk at skrive det samme begge steder.

Nejjj, jeg må desværre spinge fra, ungerne skal i seng. :-)

Kender det kun alt for godt ;0)

Hov jeg har opdaget en lille fejl den låser rækken uanset hvor mange bogstaver man indtaster - men den kode du primært anvendte er vist heller ikke i koden længere?

Minsanten om jeg ikke selv fik rettet den :0))