Option Explicit
 
Dim xlAppl As Excel.Application
Dim xlApplLiefNicht As Boolean
Dim xlWBName As String
Dim xlChart As Excel.Chart
 
 
Private Sub Form_Initialize()
  'Prüfen, ob Excel bereits ausgeführt wird:
  On Error Resume Next
  Set xlAppl = GetObject(, "Excel.Application.8")
  If Err.Number <> 0 Then xlApplLiefNicht = True
  Err.Clear   ' Err-Objekt im Fehlerfall löschen
 
End Sub
 
 
Private Sub cmderstl_Click()
 
  Dim i As Integer
 
  'Wenn Excel nicht bereits ausgeführt wird, Excel starten:
  On Error GoTo errorMsgExcel
  If xlAppl Is Nothing Then _
      Set xlAppl = CreateObject("Excel.Application.8")
  On Error GoTo 0
 
  'Excel sichtbar:
  xlAppl.Application.Visible = True
 
  'Excel-Arbeitsmappe hinzufügen und Name zurückgeben:
  xlAppl.Workbooks.Add
  xlWBName = xlAppl.ActiveWorkbook.Name
 
  'Werte in den TextBoxen -> Excel-Worksheet (A1:A3):
  For i = 1 To 3
    xlAppl.Cells(i, 1).Value = Text1(i).Text
  Next i
  xlAppl.Cells(4, 1).Value = Label2.Caption
 
  'Excel-Tabellenbereich markieren:
  xlAppl.Cells(1, 1).CurrentRegion.Select
 
  'Excel-Diagramm hinzufügen:
  Set xlChart = xlAppl.Charts.Add()
  xlChart.Type = xl3DColumn                'Säulendiagramm 3D
  'xlChart.Type = xlPie                     'Kreisdiagramm
  'xlChart.Type = xl3DPie                   'Kreisdiagramm 3D
  'xlChart.Type = xlLine                    'Liniendiagramm
  'xlChart.Type = xl3DArea                  'Flächendiagramm 3D
  'xlChart.Type = xlXYScatter               'Liniendiagramm
 
  'Excel-Diagramm rotieren lassen:          'nur möglich,wenn Diagramm 3D
  For i = 30 To 180 Step 2
    xlChart.Rotation = i
  Next
 
  Exit Sub
 
errorMsgExcel:
  MsgBox "Konnte keine Verbindung zu Excel herstellen !", _
         16, "Problem"
End Sub
 
 
Private Sub cmdbend_Click()
 
  'Excel "aufräumen":
  On Error Resume Next
  xlAppl.Workbooks(xlWBName).Close SaveChanges:=False
 
  'Wenn Excel nicht bereits ausgeführt wurde, schliessen:
  If xlApplLiefNicht Then xlAppl.Application.Quit
 
  'Verweise freigeben:
  Set xlChart = Nothing
  Set xlAppl = Nothing
 
  Unload Me
  End
 
End Sub
 
'Bei Änderung der TextBox die Summe berechnen:
Private Sub Text1_Change(Index As Integer)
  Dim summe As Integer
  Dim i As Integer
 
  summe = 0
  For i = 1 To 3
    summe = summe + Val(Text1(i))
  Next i
  Label2.Caption = Str$(summe)
 
End Sub
 
 
'--------------------------------------------------------------------------
'Nur Zahlen zulassen:
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
 
 
  Select Case KeyAscii
    Case Asc("0") To Asc("9"), 8, 13, 44, 46    'inkl. BackSpace & Return
  Case Else                                     '44="," 46="."
    KeyAscii = 0
  End Select
End Sub
'--------------------------------------------------------------------------
 
 
Private Sub Text1_GotFocus(Index As Integer)
  Text1(Index).SelStart = 0
End Sub