Option Explicit

Dim xlAppl As Object
Dim xlApplLiefNicht As Boolean
Dim xlWB As Object
Dim xlWBName As String
Dim xlTabellenName As String

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

Sub xlStarten()
  On Error GoTo errorMsgExcel
  If xlAppl Is Nothing Then _
    Set xlAppl = CreateObject("Excel.Application")

  On Error GoTo errorMsgXLMappe
  Set xlWB = xlAppl.Workbooks.Add
  On Error GoTo 0

  xlWBName = xlWB.Name

  Call Ereignis_Tabelle1_Einfuegen

  xlAppl.Application.Visible = True
  Exit Sub

errorMsgExcel:
  MsgBox "Konnte keine Verbindung zu Excel herstellen !", _
         16, "Problem"
  Exit Sub

errorMsgXLMappe:
  MsgBox "Es traten Probleme bei der Erstellung" & _
         " einer neuen Arbeitsmappe auf !", 16, "Problem"
    If xlApplLiefNicht Then xlAppl.Application.Quit
    Set xlAppl = Nothing
  Exit Sub
End Sub

Sub Ereignis_Tabelle1_Einfuegen()
  Dim neuesEreignis As Object
  Dim strCode As String

  xlTabellenName = "Tabelle1"

  Set neuesEreignis = xlWB.VBProject.VBComponents _
      (xlTabellenName).CodeModule

  strCode = _
    "Private Sub Worksheet_SelectionChange(ByVal _" & vbCr & _
    "      Target As Excel.Range)" & vbCr & _
    "  'Bei Klick in einer Zelle wird der aktiven" & vbCr & _
    "  'Zelle die Farbe hellgrün zugewiesen und als" & vbCr & _
    "  'Zellwert die Zell-Adresse hinzugefügt" & vbCr & _
    "  With ActiveCell" & vbCr & _
    "    .Interior.ColorIndex = 35" & vbCr & _
    "    .Value = ActiveCell.AddressLocal" & vbCr & _
    "  End With" & vbCr & _
    "End Sub"

  neuesEreignis.AddFromString strCode
  Set neuesEreignis = Nothing
End Sub

Private Sub cmdBeenden_Click()
  On Error Resume Next

  If Not xlAppl Is Nothing Then
    If Not xlWB Is Nothing Then
      xlWB.Close SaveChanges:=False
      Set xlWB = Nothing
    End If

    If xlApplLiefNicht Then xlAppl.Application.Quit
    Set xlAppl = Nothing
  End If

End Sub