Åbning af access-databasde fra Excvel.

Via VBA kan brugergrænsefladen udvikles i Excel, som via en reference kan kommunikere med databasen.

- så ja......

Dit svar er for mig ret intetsigender. Det giver mig forhåbning om et brugbart svar, og heller ikke mere. Jeg har brug for noget mere konkret.

Har et eksempel i løbet af i morgen...

venter spændt

Send en mail til:

pb (a) supertekst-it DOT dk

så returnerer jeg demo-database + excelfil m/kode

Demo modtaget. Et herligt arbejdsgrundlag til at komme videre.

Jeg fik selv mine 60 point. Det var superekst, der skulle bhave modtaget dem. Hvordan retter man en sådan fejl.

Du oprettet et nyt spørgsmål:

Point til Supertekst
og refererer til det tidligere spørgsmål nr. 865127

Dejligt når løsningen ikke bliver postet...

Undskyld - hvis....

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