Macro that assigns strikethrough to the Delete key.

[Bernadette]

Is it possible to create a macro that assigns strikethrough to the delete key? Whenever the user presses the delete key it will strikethrough the text instead of deleting it. This macro will need to stay on until turned off.

[gmaxey]

Sub DeleteKeyMacro()
Selection.Font.StrikeThrough = Not Selection.Font.StrikeThrough
End Sub
Sub Set_KeyBinding()
CustomizationContext = ActiveDocument.AttachedTemplate
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyDelete), _
KeyCategory:=wdKeyCategoryMacro, Command:="DeleteKeyMacro"
ActiveDocument.AttachedTemplate.Save
End Sub
Sub Kill_KeyBinding()
CustomizationContext = ActiveDocument.AttachedTemplate
FindKey(KeyCode:=BuildKeyCode(wdKeyDelete)).Clear
ActiveDocument.AttachedTemplate.Save
End Sub

[Bernadette]

Amazing! Would it be possible to add the backspace key as well?

[gmaxey]

What do you want the backspace key to do?

[Bernadette]

The same thing as the delete key. Whenever the user presses the Backspace key it applies strikethrough.

[Bernadette]

I just noticed that when I select the text first the delete key applies the strikethrough. However, if I just press the Delete key without selecting anything first it does not do anything.

[gmaxey]

If there is nothing selected then there is nothing to strikethough. What would you expect it to do. As is, it functions the same as clicking the strikethough icon on the ribbon.

[Bernadette]

Thank you so much. It will work.

[gmaxey]

Maybe something like this is what you are after:


Sub BackspaceKeyMacro()
Dim oRng As Range
On Error GoTo lbl_Exit
If Selection.Type = wdSelectionIP Then
Set oRng = Selection.Characters.First.Previous
oRng.Font.StrikeThrough = Not oRng.Font.StrikeThrough
oRng.Collapse wdCollapseStart
oRng.Select
Else
Selection.Font.StrikeThrough = Not Selection.Font.StrikeThrough
Selection.Collapse wdCollapseStart
End If
lbl_Exit:
Exit Sub
End Sub
Sub DeleteKeyMacro()
Dim oRng As Range
On Error GoTo lbl_Exit
If Selection.Type = wdSelectionIP Then
Set oRng = Selection.Characters.First
oRng.Font.StrikeThrough = Not oRng.Font.StrikeThrough
oRng.Collapse wdCollapseEnd
oRng.Select
Else
Selection.Font.StrikeThrough = Not Selection.Font.StrikeThrough
Selection.Collapse wdCollapseEnd
End If
lbl_Exit:
Exit Sub
End Sub

Sub Set_KeyBinding()
CustomizationContext = ActiveDocument.AttachedTemplate
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyDelete), _
KeyCategory:=wdKeyCategoryMacro, Command:="DeleteKeyMacro"
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyBackspace), _
KeyCategory:=wdKeyCategoryMacro, Command:="BackspaceKeyMacro"
ActiveDocument.AttachedTemplate.Save
End Sub
Sub Kill_KeyBinding()
CustomizationContext = ActiveDocument.AttachedTemplate
FindKey(KeyCode:=BuildKeyCode(wdKeyDelete)).Clear
FindKey(KeyCode:=BuildKeyCode(wdKeyBackspace)).Clear
ActiveDocument.AttachedTemplate.Save
End Sub

[Bernadette]

Absolutely amazing! Works perfectly. Thank you!