Tipp 0051 Excel-Tabellen mit VB bearbeiten
Autor/Einsender:
Datum:
  Angie
30.04.2001
Entwicklungsumgebung:   VB 5
In diesem Beispiel wird eine der vielen Möglichkeiten gezeigt, wie mit Visual Basic (nicht VBA) aus einer Excel-Arbeitsmappe Daten eingelesen, geändert, gelöscht und hinzugefügt werden können.
 
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
 
Hinweis
Um diesen Tipp ausführen zu können, muss Excel installiert sein und zur Entwurfszeit die Microsoft Excel x.0 Object Library in das Projekt eingebunden werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (20,7 kB) Downloads bisher: [ 7910 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 30. August 2011