View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Norman Jones[_2_] Norman Jones[_2_] is offline
external usenet poster
 
Posts: 421
Default Allow macro to work for a group of cells but not the other cells

Hi Eric,

At the top of a standard module, brfore
any other code try the following minor
modificarion:

'===========
Option Explicit
Const PWORD As String = "Pluto" '<<=== CHANGE

'-------------
Public Sub mrkArbeidstid()
'
' mrkTilbakestill Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen
Dim Rng As Range
Dim rng2 As Range
Dim rArea As Range

Set Rng = ActiveSheet.Range("A1:D20") '<<=== CHANGE

On Error Resume Next
Set rng2 = Intersect(Selection, Rng)
On Error GoTo 0

If rng2 Is Nothing Then
Exit Sub
End If

ActiveSheet.Unprotect Password:=PWORD
For Each rArea In rng2.Areas
With rArea
.Font.ColorIndex = 35
.Formula = "a"
With .Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End With
Next rArea

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
End Sub

'-------------
Public Sub mrkTilbakestill()
'
' mrkTilbakestill Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen
Dim Rng As Range
Dim rng2 As Range
Dim rArea As Range

Set Rng = ActiveSheet.Range("A1:D20") '<<=== CHANGE

On Error Resume Next
Set rng2 = Intersect(Selection, Rng)
On Error GoTo 0

If rng2 Is Nothing Then
Exit Sub
End If

ActiveSheet.Unprotect
For Each rArea In rng2.Areas
With rArea
.Interior.ColorIndex = xlNone
.ClearContents
End With
Next rArea

ActiveSheet.Protect _
Password:=PWORD, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
End Sub
'<<===========


---
Regards.
Norman


wrote in message
...
On 3 mei, 20:18, "Norman Jones"

Thank you for quick and usefull help.
It works fantastic.

There is only one thing that is missing now and that is to protect the
sheet with a password.
I thought that that would be easy since I saw several examples in this
discusion group.
But as always, nothing is as easy as it looks.
I tried the following but get an error message for the
ActiveSheet.Protect part.
Can you help me out with this?

ActiveSheet.Unprotect Password:="test"
For Each rArea In Rng2.Areas
With rArea
.Font.ColorIndex = 35
.Formula = "a"
With .Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End With
Next rArea


ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
Password:="test"

Thanks

Eric