AW: Access in Excel Bringen
06.07.2005 11:31:32
bst
Hallo Timo,
Bitteschön. Nimm sowas hinter die Tabelle.
HTH, Bernd
--
Option Explicit
' benötigt im VBA einen Verweis auf M$ DAO x.y Object Library !!!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range ' eine Zelle aus Target, dort können mehrere Zellen stehen !
Dim dbs As Database ' Datenbank
Dim dbfile As String ' Datenbankname inkl. Pfad
Dim qdf As QueryDef ' Datenbankabfrage
Dim rec As Recordset ' Ergebnis der Datenbankabfrage
Dim mysql As String ' ein SQL-Befehl
Dim myTxt As String ' die aktuelle Artikelbezeichnung
' Falls nicht in Spalte A, fertig
If Intersect(Target, Columns(1)) Is Nothing Then Exit Sub
On Error GoTo myERR
dbfile = "c:\cisco.mdb"
Set dbs = OpenDatabase(dbfile)
For Each cell In Target
If cell.Column = 1 Then ' nur falls in Spalte A
myTxt = Cells(cell.Row, 1).Value
mysql = "SELECT F5 FROM Artikel WHERE F2 = '" & myTxt & "';"
Set qdf = dbs.CreateQueryDef("", mysql)
' Ergebnis der Abfrage holen
Set rec = qdf.OpenRecordset(dbOpenSnapshot)
If Not rec.EOF Then
Application.EnableEvents = False
Cells(cell.Row, 2).NumberFormat = "@"
Cells(cell.Row, 2).Value = rec.Fields(0).Value
Application.EnableEvents = True
End If
End If
Next
myERR:
If Err.Number Then MsgBox Err.Description, vbCritical, "Fehler: " & Err.Number
On Error GoTo 0
Application.EnableEvents = True
Set dbs = Nothing
End Sub