Attribute VB_Name = "Modul1"

'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

Sub invert_select()
'On Error Resume Next
  
  'number of old areas
  Dim noa As Integer
  noa = Selection.Areas.Count
  ReDim arng(noa) As Range
  ReDim nrng(noa) As Range
  
  Dim o_range As Range
  Dim n_range As Range
  Dim i As Long
  
  Set o_range = Selection
  If noa < 1 Then Exit Sub 'oder ganzes Blatt wählen?
  For i = 1 To noa
     Set arng(i) = o_range.Areas.Item(i)
     'MsgBox arng(i).Address
     Set nrng(i) = Range(invers_selection(arng(i)))
     'MsgBox nrng(i).Address
     Next i
     Set n_range = nrng(1)
     If noa >= 2 Then
        For i = 2 To noa
           Set n_range = Intersect(n_range, nrng(i))
        Next i
        End If
  On Error GoTo err_Select
  n_range.Select
  Exit Sub
err_Select:
  'wenn n_range eigentlich leer ist
  'setze Selection auf die aktive Zelle
  Set n_range = ActiveCell
  Resume
  End Sub
  
Public Sub reduce_selection_to_UsedRange()
   If ActiveSheet.UsedRange.Cells.Count > 0 Then Intersect(Selection, ActiveSheet.UsedRange).Select
End Sub

Public Sub reduce_selection_to_VisibleRange()
   If ActiveWindow.VisibleRange.Cells.Count > 0 Then Intersect(Selection, ActiveWindow.VisibleRange).Select
End Sub


Private Function invers_selection(act_select As Range) As String
On Error Resume Next
   Dim part1 As Range
   Dim part2 As Range
   Dim part3 As Range
   Dim part4 As Range
   Dim p As Integer
   p = 0
   If act_select.Row > 1 Then
      Set part1 = Rows("1:" & act_select.Row - 1)
      p = 1
      End If
   If act_select.Row + act_select.Rows.Count - 1 < 65536 Then
      Set part2 = Rows(act_select.Row + act_select.Rows.Count & ":65536")
      p = p + 2
      End If
      
   If act_select.Column > 1 Then
      Set part3 = Range(Columns(1), Columns(act_select.Column - 1))
      p = p + 4
      End If
   If act_select.Column + act_select.Columns.Count - 1 < 256 Then
      Set part4 = Range(Columns(act_select.Column + act_select.Columns.Count), Columns(256))
      p = p + 8
      End If
      invers_selection = ""
      Do While p > 0
      Select Case p
         Case 0:
         Case 1, 3, 5, 7, 9, 11, 13, 15:
                 If invers_selection = "" Then
                    invers_selection = part1.Address
                    Else
                    invers_selection = Union(Range(invers_selection), part1).Address
                    End If
                    p = p - 1
         Case 2, 6, 10, 14:
                 If invers_selection = "" Then
                    invers_selection = part2.Address
                    Else
                    invers_selection = Union(Range(invers_selection), part2).Address
                    End If
                    p = p - 2
         Case 4, 12:
                 If invers_selection = "" Then
                    invers_selection = part3.Address
                    Else
                    invers_selection = Union(Range(invers_selection), part3).Address
                    End If
                    p = p - 4
         Case 8:
                 If invers_selection = "" Then
                    invers_selection = part4.Address
                    Else
                    invers_selection = Union(Range(invers_selection), part4).Address
                    End If
                    p = p - 8
         Case Else: invers_selection = ""
         End Select
         Loop
End Function