Option Explicit

Const xlDateiName As String = "Beispiel.xls"
Const xlWS_Name As String = "AdressDaten"

Private xlAppl As Object
Private xlApplLiefNicht As Boolean

Private xlWB As Object
Private xlWS As Object

Private Sub Form_Load()
  Dim boolWBOffen As Boolean
  Dim wb As Object

  Dim lngNumRows As Long

  On Error Resume Next
  Set xlAppl = GetObject(, "Excel.Application")
  If Err.Number <> 0 Then xlApplLiefNicht = True

  Err.Clear
  If xlAppl Is Nothing Then
    Set xlAppl = CreateObject("Excel.Application")

    If Err.Number <> 0 Then
      MsgBox "Konnte keine Verbindung zu Excel herstellen !", _
             vbOKOnly + vbCritical, Title:=Me.Caption
      GoTo err_Handler
    End If
  End If

  boolWBOffen = False

  If Not xlApplLiefNicht Then
    If xlAppl.Workbooks.Count > 0 Then
      For Each wb In xlAppl.Workbooks
        If LCase(wb.Name) = LCase(xlDateiName) Then
          boolWBOffen = True
          Exit For
        End If
      Next
    End If
  End If

  On Error Resume Next
  If Not boolWBOffen Then
    Err.Clear
    Set xlWB = xlAppl.Workbooks.Open( _
          FileName:=App.Path & "\" & xlDateiName)

    If Err.Number <> 0 Then
      MsgBox "Die Arbeitsmappe '" & xlDateiName & _
             "' konnte nicht geöffnet werden !", _
             vbOKOnly + vbCritical, Title:=Me.Caption
      If xlApplLiefNicht Then xlAppl.Application.Quit
      Set xlAppl = Nothing
      GoTo err_Handler
    End If

  Else
    Set xlWB = xlAppl.Workbooks(xlDateiName)
  End If

  On Error GoTo 0

  Set xlWS = xlWB.Worksheets(xlWS_Name)

  lngNumRows = xlWS.Range("A65536").End(xlUp).Row

  If lngNumRows >= 2 Then
    xlSpaltenEinlesen
    cmbAuswahl.ListIndex = 0
  Else
    EnableControls False
  End If

  Exit Sub
 
err_Handler:
  Dim ctl As Control

  For Each ctl In Me.Controls
    If ctl.Name <> "cmdBeenden" Then
      ctl.Enabled = False
    End If
  Next ctl
 
  Exit Sub
End Sub

Private Sub xlSpaltenEinlesen()
  Dim lngNumRows As Long
  Dim lngRowIndex As Long
  Dim intColIndex As Integer
  Dim strTemp As String

    cmbAuswahl.Clear

    lngNumRows = xlWS.Range("A65536").End(xlUp).Row
    intColIndex = 1
    For lngRowIndex = 2 To lngNumRows
       strTemp = xlWS.Cells(lngRowIndex, intColIndex).Value & _
            ", " & xlWS.Cells(lngRowIndex, intColIndex + 1).Value
       cmbAuswahl.AddItem strTemp
    Next lngRowIndex
End Sub

Private Sub cmbAuswahl_Click()
  Dim lngRowIndex As Long
  Dim intColIndex As Integer

  lngRowIndex = cmbAuswahl.ListIndex + 2

  For intColIndex = 1 To 5
    Text1(intColIndex).Text = _
          xlWS.Cells(lngRowIndex, intColIndex).Value
  Next intColIndex
End Sub

Private Sub cmdAendern_Click()
  Dim lngRowIndex As Long
  Dim intColIndex As Integer

  lngRowIndex = cmbAuswahl.ListIndex + 2

  For intColIndex = 1 To 5
    xlWS.Cells(lngRowIndex, intColIndex).Value = _
          Text1(intColIndex).Text
  Next intColIndex

  cmbAuswahl.List(cmbAuswahl.ListIndex) = _
        Text1(1).Text & ", " & Text1(2).Text
End Sub

Private Sub cmdLoeschen_Click()
  Dim lngListIndex As Long
  Dim lngRowIndex As Long
  Dim i As Integer

  lngListIndex = cmbAuswahl.ListIndex
  lngRowIndex = lngListIndex + 2

  xlWS.Cells(lngRowIndex, 1).EntireRow.Delete

  cmbAuswahl.RemoveItem lngListIndex

  If cmbAuswahl.ListCount = 0 Then
    For i = 1 To 5
      Text1(i).Text = vbNullString
    Next i
    EnableControls False

  Else
    If lngListIndex + 1 > cmbAuswahl.ListCount Then
      cmbAuswahl.ListIndex = cmbAuswahl.ListCount - 1
    Else
      cmbAuswahl.ListIndex = lngListIndex
    End If
  End If
End Sub

Private Sub cmdHinzufuegen_Click()
  Dim lngNumRows As Long
  Dim intColIndex As Integer

  lngNumRows = xlWS.Range("A65536").End(xlUp).Row
  lngNumRows = lngNumRows + 1

  For intColIndex = 1 To 5
    xlWS.Cells(lngNumRows, intColIndex).Value = _
          Text1(intColIndex).Text
  Next intColIndex

  cmbAuswahl.AddItem Text1(1).Text & ", " & Text1(2).Text
  cmbAuswahl.ListIndex = cmbAuswahl.ListCount - 1

  EnableControls True
End Sub

Private Sub cmdSortieren_Click()
  Dim xlRange As Object     ' As Excel.Range

  Set xlRange = xlWS.Columns("A:E")
  xlRange.Sort Key1:=xlWS.Range("A1"), _
      Key2:=xlWS.Range("B1"), Header:=xlYes
  Set xlRange = Nothing

  xlSpaltenEinlesen
  cmbAuswahl.ListIndex = 0
End Sub

Private Sub EnableControls(ByVal vboolEnabled As Boolean)
  lblAuswahl.Enabled = vboolEnabled
  cmbAuswahl.Enabled = vboolEnabled

  cmdAendern.Enabled = vboolEnabled
  cmdLoeschen.Enabled = vboolEnabled
  cmdHinzufuegen.Enabled = vboolEnabled
  cmdSortieren.Enabled = vboolEnabled
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, _
      UnloadMode As Integer)

  On Error Resume Next
  If Not xlAppl Is Nothing Then
    If Not xlWB Is Nothing Then
      xlWB.Close SaveChanges:=False
      Set xlWS = Nothing
      Set xlWB = Nothing
    End If
    
    If xlApplLiefNicht Then xlAppl.Application.Quit
    Set xlAppl = Nothing
  End If
  End
End Sub