Option Explicit
Private Sub Workbook_Open()
Application.OnKey "^%N", "ShowSheetNavigator"
Application.OnKey "^%n", "ShowSheetNavigator"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "^%N"
Application.OnKey "^%n"
Unload ufmSheetNavigator
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim sht As Object
Static intSheetCount As Integer
On Error GoTo ErrorHandler
If Application.EnableEvents = True Then
If ufmSheetNavigator.Visible Then
If Sheets.Count <> intSheetCount Then
With ufmSheetNavigator
.lstSheets.Clear
For Each sht In Sheets
If sht.Visible = xlSheetVisible Then
.lstSheets.AddItem (sht.Name)
End If
Next
Application.EnableEvents = False
.lstSheets.ListIndex = Sheets(ActiveSheet.Name).Index - 1
Application.EnableEvents = True
End With
intSheetCount = Sheets.Count
End If
End If
End If
ErrorHandler:
Application.EnableEvents = True
End Sub
Sub ShowSheetNavigator()
Load ufmSheetNavigator
ufmSheetNavigator.Show vbModeless
End Sub
Option Explicit
Private Sub UserForm_Activate()
Dim sht As Object
Me.btnDelete.ControlTipText = "Delete"
Me.btnDelete.Default = True
Me.btnExit.Cancel = True
Me.btnDelete.TakeFocusOnClick = False
Me.btnExit.TakeFocusOnClick = False
Me.lstSheets.Clear
For Each sht In Sheets
If sht.Visible = xlSheetVisible Then
Me.lstSheets.AddItem (sht.Name)
End If
Next
Application.EnableEvents = False
Me.lstSheets.ListIndex = Sheets(ActiveSheet.Name).Index - 1
Application.EnableEvents = True
End Sub
Private Sub lstSheets_Click()
On Error GoTo ErrorHandler
If Application.EnableEvents = True Then
With Me.lstSheets
If .ListIndex > -1 Then
Application.EnableEvents = False
Sheets(.List(.ListIndex)).Activate
Application.EnableEvents = True
End If
End With
End If
ErrorHandler:
Application.EnableEvents = True
End Sub
Private Sub btnDelete_Click()
Dim Answer As VbMsgBoxResult, blnNoDelete As Boolean
On Error Resume Next
With Me.lstSheets
If Me.lstSheets.ListCount > 0 And Me.lstSheets.ListIndex > -1 Then
Answer = MsgBox("Confirm delete of selected Sheet.", _
vbOKCancel + vbExclamation + vbDefaultButton2, "Delete Sheet")
If Answer = vbOK Then
Application.EnableEvents = False
Application.DisplayAlerts = False
Sheets(.List(.ListIndex)).Delete
If Err Then
blnNoDelete = True
GoTo ErrorHandler
End If
Application.DisplayAlerts = True
.RemoveItem (.ListIndex)
Application.EnableEvents = True
End If
Else
Beep
End If
End With
ErrorHandler:
If blnNoDelete Then
MsgBox "Cannot delete Sheet." & vbCrLf & _
"Probable reasons: Workbook protected or only Sheet.", _
vbExclamation, "Delete failed"
End If
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Private Sub btnExit_Click()
Unload Me
End Sub
|