This macro works perfectly but for some reason I can now no longer add a shortcut key to it
I went to Alt+F8, selected the macro, went to options and added the small letter P (also tried D just in case) clicked ok but when I entered Ctrl+Shift+P nothing at all happened. When I go to Alt+F11 and run the code manually, it works perfectly
Public Sub Print_Page_of_ActiveCell()
Dim ActiveRow As Long, ActiveCol As Integer
Dim iHPBs As Integer, iVPBs As Integer
Dim iRow As Integer, iCol As Integer, iPage As Integer
ActiveRow = ActiveCell.Row
ActiveCol = ActiveCell.Column
ActiveSheet.UsedRange
If IsEmpty(ActiveCell.SpecialCells(xlCellTypeLastCell)) Then _
ActiveCell.SpecialCells(xlCellTypeLastCell).FormulaR1C1 = " "
If ActiveRow > ActiveCell.SpecialCells(xlCellTypeLastCell).Row Or _
ActiveCol > ActiveCell.SpecialCells(xlCellTypeLastCell).Column Then _
Exit Sub
With ActiveSheet
iHPBs = .HPageBreaks.Count
iVPBs = .VPageBreaks.Count
If iHPBs = 0 And iVPBs = 0 Then Goto PrintSheet
Horizontal:
For iRow = iHPBs To 1 Step -1
If .HPageBreaks(iRow).Location.Row <= ActiveRow Then Goto Vertical
Next iRow
Vertical:
For iCol = iVPBs To 1 Step -1
If .VPageBreaks(iCol).Location.Column <= ActiveCol Then Goto PrintSheet
Next iCol
PrintSheet:
iPage = (iRow + 1) + (iCol * (iHPBs + 1))
.PrintOut From:=iPage, To:=iPage
MsgBox "Printing page " & iPage
End With
If ActiveCell.SpecialCells(xlCellTypeLastCell).FormulaR1C1 = " " Then _
Selection.SpecialCells(xlCellTypeLastCell).ClearContents
End Sub
I went to Alt+F8, selected the macro, went to options and added the small letter P (also tried D just in case) clicked ok but when I entered Ctrl+Shift+P nothing at all happened. When I go to Alt+F11 and run the code manually, it works perfectly
Public Sub Print_Page_of_ActiveCell()
Dim ActiveRow As Long, ActiveCol As Integer
Dim iHPBs As Integer, iVPBs As Integer
Dim iRow As Integer, iCol As Integer, iPage As Integer
ActiveRow = ActiveCell.Row
ActiveCol = ActiveCell.Column
ActiveSheet.UsedRange
If IsEmpty(ActiveCell.SpecialCells(xlCellTypeLastCell)) Then _
ActiveCell.SpecialCells(xlCellTypeLastCell).FormulaR1C1 = " "
If ActiveRow > ActiveCell.SpecialCells(xlCellTypeLastCell).Row Or _
ActiveCol > ActiveCell.SpecialCells(xlCellTypeLastCell).Column Then _
Exit Sub
With ActiveSheet
iHPBs = .HPageBreaks.Count
iVPBs = .VPageBreaks.Count
If iHPBs = 0 And iVPBs = 0 Then Goto PrintSheet
Horizontal:
For iRow = iHPBs To 1 Step -1
If .HPageBreaks(iRow).Location.Row <= ActiveRow Then Goto Vertical
Next iRow
Vertical:
For iCol = iVPBs To 1 Step -1
If .VPageBreaks(iCol).Location.Column <= ActiveCol Then Goto PrintSheet
Next iCol
PrintSheet:
iPage = (iRow + 1) + (iCol * (iHPBs + 1))
.PrintOut From:=iPage, To:=iPage
MsgBox "Printing page " & iPage
End With
If ActiveCell.SpecialCells(xlCellTypeLastCell).FormulaR1C1 = " " Then _
Selection.SpecialCells(xlCellTypeLastCell).ClearContents
End Sub