Private Sub Worksheet_SelectionChange(ByVal Target As Range) Range("S15:EG15").Interior.ColorIndex = 0 If Not Intersect(Target, Range("S15:EG15")) Is Nothing Then For x = 19 To 137 If Cells(15, x).Column / 2 = Int(Cells(15, x).Column / 2) Then Cells(15, x).Interior.ColorIndex = 3 End If Next End If End Sub
Det forstår jeg ikke. Koden aktiveres når der skiftes celle, og cellefarvningen forsvinder. Hvis der skiftes til en af cellerne i S15:EG15 farves hver anden celle i omådet S15:EG15 rødt
Jeg glemte at fortælle at arket er arkbeskyttet men at cellerne S15 til EG15 er frie og ubeskyttet. Det giver fejl. For hvis jeg fjerner Arkbeskyttelsen, så er der ikke kodefejl. Arket skal være beskyttet.
De relevante celler har farven mørk grøn RGB: 0;137;134. Der sker dette: Alle relevante celler bliver 'hvide' og mellemrum fra R15 og frem bliver røde. Kun den celle (ud af de elevante) som clickes på, skal blive rød.
Hvis du med “mellemrum” mener inaktive celler mellem de aktive tror jeg at jeg står af her. Det giver kun besvær, hvis man af hensyn til layout bruger ekstra celler mellem de aktive celler, og det ønsker jeg ikke at bruge tid på.
Du misforstår opgaven. Kun den celle, der er bliver clicket på, skal have rød fyldfarve og kun indtil musen flyttes. Det skal gælde for cellerne (i række 15) S15, U15, W15 og indtil celle EG15. Dvs hver anden celle og 60 celler i alt. Koden skal følge musens placering og reagere på ovennævnte celler med rød fyldfarve.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("S15:EG15")) Is Nothing Then Worksheets("Sheet1").Unprotect For x = 19 To 137 Step 2 If Target.Column = x Then Cells(15, x).Interior.ColorIndex = 3 Else Cells(15, x).Interior.Color = RGB(0, 137, 134) End If Next Worksheets("Sheet1").Protect End If End Sub
Hvis det er med password, skal du lige rette to linjer: Worksheets("Sheet1").Unprotect og Worksheets("Sheet1").Protect til Worksheets("Sheet1").Unprotect Password:="My Password" Worksheets("Sheet1").Protect Password:="My Password"
Jeg skrev : Koden er uden virkning uden for området, OK: Men det er ikke helt rigtigt. Koden virker også i mellemrum, og det skal den jo ikke. Men det går måske godt, hvis kører helt til ende, men farven er ikke grøn i mellemrum, men grå RBG (231,230;230).
Jeg har lavet en hjælpe række 7 som tæller de valide kolonner op med 1 fra S=1, U=2 .. til EG=60. Mellemrum er 0. Stadig kun gældende fra S til EG. Kan du bruge det.
Jeg har lavet en lille rettelse, og nu kører koden
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("S15:EG15")) Is Nothing Then ActiveSheet.Unprotect For x = 19 To 137 Step 2 If Target.Column = x Then Cells(15, x).Interior.ColorIndex = 3 Else Cells(15, x).Interior.Color = RGB(0, 137, 134) End If Next ActiveSheet.Protect End If End Sub
Men, men hvis jeg flytter musen til en vilkårlig anden celle (som ikke er S15 til EG15). så er cellen stadig rød, og det skal den ikke være.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Unprotect For x = 19 To 137 Step 2 Cells(15, x).Interior.Color = RGB(0, 137, 134) Next If Not Intersect(Target, Range("S15:EG15")) Is Nothing Then For x = 19 To 137 Step 2 If Target.Column = x Then Cells(15, x).Interior.ColorIndex = 3 Else Cells(15, x).Interior.Color = RGB(0, 137, 134) End If Next ActiveSheet.Protect End If End Sub
Koden spiller 100%. Tusind tak endnu engang. mvh Knud Evendorff
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.