Forbindelse mellem excel og access

Send en mail til mig - så returnerer jeg eksempel...

Hej Supertekst

Denne her fik jeg heller aldrig honoreret dig for.
Beklager den sene tilbagemelding..

Har du et svar :-)

OK - kan du vise løsningen heri.

Koden kommer her:

Rem Database-def.
Public db As database, tbl_budget
Dim flag As Boolean

Dim xSti
Public Sub findSti()
    xSti = ActiveWorkbook.Path
    If Right(xSti, 1) <> "\" Then
        xSti = xSti + "\"
    End If
End Sub
Rem Database - rutiner
Rem ==================
Public Sub LukDb()
    On Error Resume Next
   
    tbl_budget.Close
    db.Close
End Sub
Public Sub åbnDatabase()
    findSti
    Set db = OpenDatabase(xSti + "budget.mdb")
End Sub
Public Sub åbnBudgetTabel()
    åbnDatabase
    Set tbl_budget = db.OpenRecordset("budget")
End Sub
Public Function findAfdeling(afdNr)
On Error GoTo fejl

    åbnBudgetTabel
   
    With tbl_budget
        .Index = "primarykey"
        .Seek "=", afdNr
   
        If Not .NoMatch Then
            findAfdeling = True
        Else
            findAfdeling = False
        End If
    End With
    Exit Function
   
fejl:
    findAfdeling = False
End Function
Rem ================
Rem Excel-funktioner
Rem ================
Private Sub worksheet_Change(ByVal Target As Excel.Range)
Dim aktuelleRække, aktuelleKolonne, aktuelleAfd, aktuelleVærdi, feltnr

On Error Resume Next

Rem Kolonne A - AFDELINGSNUMMER
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        flag = True
        If findAfdeling(Target.Value) = True Then
            indsætDataFraDB Target.Row
        Else
            If Target.Value <> "" Then
                MsgBox ("AfdNr.:" & CStr(Target.Value) & " kan ikke findes")
            End If
        End If
    Else
Rem Kolonne E - F - G BUDGETTAL
        If Not Intersect(Target, Range("E:E;F:F;G:G")) Is Nothing Then
            If flag = False Then
                aktuelleKolonne = Target.Column
                aktuelleRække = Target.Row
                aktuelleAfd = Cells(aktuelleRække, 1)
                aktuelleVærdi = Cells(aktuelleRække, aktuelleKolonne)
                feltnr = aktuelleKolonne - 1
Rem Klar til opdatering
                If findAfdeling(aktuelleAfd) = True And IsNumeric(aktuelleVærdi) = True Then
                    opdaterFelt feltnr, aktuelleVærdi
                End If
            End If
        End If
    End If
   
End Sub
Private Sub opdaterFelt(feltnr, værdi)
    With tbl_budget
        .Edit
        .Fields(feltnr) = værdi
        .Update
    End With
End Sub
Private Sub indsætDataFraDB(rækkeNr)
    With ActiveSheet
        For x = 1 To 6
            .Cells(rækkeNr, x + 1) = tbl_budget.Fields(x)
        Next x
    End With
   
    flag = False
End Sub
Private Sub Worksheet_Deactivate()
    LukDb
End Sub