application.onkey depending on a if function.

[TravelDrome]

Dear excel friends,

My challenge is to find out the following:

Sub exam.()
if Sheets("Sheet1").protect=true Then
application.OnKey "{DELETE}","key"
end if
end sub

and

Sub key()
ActiveSheet.Unprotect ("password")
end sub

does the "application OnKey" works as well depending on an if function? In case the sheet is unprotected, the delete button should be used to clear the cell contents.

Hope you can help me out.

kind regards,

[jason.b75]

Something like

If ActiveSheet.ProtectContents Then
    Call Key
    Selection.ClearContents
End If

[TravelDrome]

Dear Jason.b75

your code says something like " if the contents of the cell are protected, i hit a key and the selection will be deleted".

However I would like the following. When i hit the delete button and the worksheet is protected, not the workbook, there should pop up a userform asking "Are you sure you want to unlock the sheet" with a button "yes" and "no". In case you push "yes", the sheet will be unprotected. In case "no" you go back without any act.
When the sheet is unprotected, the userform shouldn t pop up and the delete button should be used for deleting the cell contents.

regards marc

[jason.b75]

Try

Workbook module

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.ProtectContents = True Then
    Application.OnKey "{DELETE}", "key"
Else
    Application.OnKey "{DELETE}", ""
End If
End Sub

Standard module

Sub key()
If ActiveSheet.Name = "Sheet1" And MsgBox("Are you sure you want to unlock the sheet?", vbYesNo) = vbYes Then
    ActiveSheet.Unprotect ("password")
    Selection.ClearContents
End If
End Sub

[TravelDrome]

Dear,

I have the following:

THIS WORKBOOK

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.ProtectContents = True Then
    Application.OnKey "{DELETE}", "Sheet3.key"
Else
    Application.OnKey "{DELETE}", "Sheet3.key2"
End If
End Sub

SHEET "DATABASE"

Sub key()
If ActiveSheet.Name = "DataBase" And MsgBox("Are you sure you want to unlock the sheet?", vbYesNo) = vbYes Then
        ActiveSheet.Unprotect ("cdmsum1")
        Selection.ClearContents
End If
End Sub

SHEET "DATABASE"

Sub key2()
Selection.ClearContents
End Sub

it works good for the sheet "DataBase". But in the other sheets I want the delete key to have its normal function instead of popping up the message box. You now what to change?

with kind regards,

marc

[TravelDrome]

Dear,

I have the following:

THIS WORKBOOK

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.ProtectContents = True Then
    Application.OnKey "{DELETE}", "Sheet3.key"
Else
    Application.OnKey "{DELETE}", "Sheet3.key2"
End If
End Sub

SHEET "DATABASE"

Sub key()
If ActiveSheet.Name = "DataBase" And MsgBox("Are you sure you want to unlock the sheet?", vbYesNo) = vbYes Then
        ActiveSheet.Unprotect ("cdmsum1")
        Selection.ClearContents
End If
End Sub

SHEET "DATABASE"

Sub key2()
Selection.ClearContents
End Sub

it works good for the sheet "DataBase". But in the other sheets I want the delete key to have its normal function instead of popping up the message box. You now what to change?

with kind regards,

marc

[TravelDrome]

Dear,

Thanks a lot for helping me out.

IT WORKS.

I changed the following:

THIS WORKBOOK

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.ProtectContents = True And ActiveSheet.Name = "DataBase" Then
    Application.OnKey "{DELETE}", "Sheet3.key"
Else
    Application.OnKey "{DELETE}", "Sheet3.key2"
End If
End Sub

kind regards,

marc

[TravelDrome]

Dear,

Thanks a lot for helping me out.

IT WORKS.

I changed the following:

THIS WORKBOOK

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.ProtectContents = True And ActiveSheet.Name = "DataBase" Then
    Application.OnKey "{DELETE}", "Sheet3.key"
Else
    Application.OnKey "{DELETE}", "Sheet3.key2"
End If
End Sub

kind regards,

marc