Sub EraseNames()   ' очистка списка имен диапазонов
       Dim nM As Name
       For Each nM In ActiveWorkbook.Names
           If nM.Visible Then
               If Not nM.Name Like "*!Print_Area" Then  ' имена областей печати лучше оставить
                   Select Case MsgBox("Удалить имя диапазона:" & vbCrLf & vbCrLf _
                      & nM.Name & nM.RefersTo, vbYesNoCancel + vbQuestion)
                   Case vbYes: nM.Delete
                   Case vbCancel: Exit Sub
                   End Select
               End If
           Else
               If Not nM.Name Like "*!_FilterDatabase" Then nM.Delete   ' удалить все скрытые имена диапазонов кроме фильтров
           End If
       Next nM
End Sub

Sub Draws_0D_Select()   ' выделить НА ЛИСТЕ все рисунки с нулевыми размерами
      Dim oDraw As Shape
      If ActiveSheet.DrawingObjects.Count = 0 Then:   MsgBox "В выделенном диапазоне нет рисунков", , "Нет объектов!": Exit Sub
      For Each oDraw In ActiveSheet.DrawingObjects.ShapeRange
         If oDraw.Width = 0 Or oDraw.Height = 0 Then oDraw.Select (False)
      Next
End Sub

Sub InvertSelection()
'---------------------------------------------------------------------------------------
' Procedure : InvertSelection
' Author    : <img rel="usm" src="http://www.excelworld.ru/sml2/smile.gif" border="0" align="absmiddle" alt=":)" />
' URL       : http://www.planetaexcel.ru/forum.php?thread_id=14008
' DateTime  : 04.03.2010   00:17
' Purpose   : инвертировать Selection
' Notes     : Работает со всеми ячейками листа, поддерживается выделение нескольких несмежных диапазонов.
' Notes     : в процессе работы создаётся временный ЛИСТ в текущей книге, поэтому может не работать при защищенной структуре книги
'---------------------------------------------------------------------------------------
     If TypeName(Selection) <> "Range" Then Exit Sub
     With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With
     Dim selAddr As String: selAddr = Selection.Address
     With ActiveSheet
        With Worksheets.Add
           .Cells.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="0"
           .Range(selAddr).ClearFormats
           selAddr = .Cells.SpecialCells(xlCellTypeAllFormatConditions).Address
           .Delete
        End With
        .Range(selAddr).Select
     End With
     With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With
End Sub
Sub InvertSelection2()
'---------------------------------------------------------------------------------------
' Procedure : InvertSelection
' Author    : <img rel="usm" src="http://www.excelworld.ru/sml2/smile.gif" border="0" align="absmiddle" alt=":)" />
' URL       : http://www.planetaexcel.ru/forum.php?thread_id=14008
' DateTime  : 04.03.2010   00:17
' Purpose   : инвертировать Selection
' Notes     : Работает со всеми ячейками листа, поддерживается выделение нескольких несмежных диапазонов.
' Notes     : в процессе работы создаётся временная КНИГА, поэтому работает в том числе и при защищенной структуре книги
'---------------------------------------------------------------------------------------
     If TypeName(Selection) <> "Range" Then Exit Sub
     With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With
     Dim selAddr As String: selAddr = Selection.Address
     With ActiveSheet
        With Workbooks.Add
           With ActiveSheet
              .Cells.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="0"
              .Range(selAddr).ClearFormats
              selAddr = .Cells.SpecialCells(xlCellTypeAllFormatConditions).Address
           End With
           .Close False
        End With
        .Range(selAddr).Select
     End With
     With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With
End Sub