I added three commands to allow for inserting, deleting and removing rows in a protected file. While I was able to add the menu items correctly, I have not been able to correctly remove them when closing the workbook. The code I have thus far is below. Please let me know what I need to change to make the removal work. Thanks!
Coded into ThisWorkbook:
Coded into Module:
Coded into ThisWorkbook:
VBA Code:
Private Sub Workbook_Open()
Application.Run "'sample File Name.xlsm'!addMenuItems"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Run "'Sample Excel File.xlsm'!removeMenuItems"
End Sub
Coded into Module:
Code:
Public Sub addMenuItems()
With Application.CommandBars("row").Controls.Add(msoControlButton, , , 1, True)
.Caption = "Delete protected row"
.OnAction = "'Sample Excel File.xlsm'!deleteRow"
End With
With Application.CommandBars("row").Controls.Add(msoControlButton, , , 1, True)
.Caption = "Insert protected row"
.OnAction = "'Sample Excel File.xlsm'!insertProtectedRow"
End With
With Application.CommandBars("row").Controls.Add(msoControlButton, , , 1, True)
.Caption = "Cut&Paste protected row"
.OnAction = "'Sample Excel File.xlsm'!cutProtectedRow"
End With
End Sub
Public Sub removeMenuItems()
With Application.CommandBars("Worksheet Menu Bar")
On Error Resume Next
.Controls("Delete protected row").Delete
On Error GoTo 0
End With
With Application.CommandBars("Worksheet Menu Bar")
On Error Resume Next
.Controls("Insert protected row").Delete
On Error GoTo 0
End With
With Application.CommandBars("Worksheet Menu Bar")
On Error Resume Next
.Controls("Cut&Paste protected row").Delete
On Error GoTo 0
End With
End Sub
Public Sub deleteRow()
Application.EnableCancelKey = xlDisabled
Dim ws As Worksheet
Dim selRows As Range, CBlanks As Range, IntersectedCells As Range
On Error Resume Next
Set ws = ActiveWorkbook.Sheets("LookAhead Schedule")
Set selRows = Selection.EntireRow
Set CBlanks = Columns("C").SpecialCells(xlBlanks)
Set IntersectedCells = Intersect(selRows, CBlanks)
On Error GoTo 0
If ws.Name = ActiveWorkbook.ActiveSheet.Name Then
If ActiveCell.row > 4 Then
On Error Resume Next
ActiveSheet.ShowAllData
If Intersect(Columns("C"), selRows).Count <> IntersectedCells.Count Then
MsgBox "One or More Rows Selected are P6 Activities" & vbLf & vbLf & "Operation cancelled!", vbCritical
Else
ActiveSheet.Unprotect "password"
IntersectedCells.EntireRow.Delete
ActiveSheet.Protect _
Password:="password", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFiltering:=True
End If
Else
MsgBox "Can not Delete Header Rows 1-4"
End If
Else
MsgBox "Function Only Works in LookAhead Sheet!!!"
End If
Application.EnableCancelKey = xlInterrupt
End Sub