Excel access integration macro

Skulle ikke være et problem via VBA.

Arbejder med Office 2003.

-

Er der flydende indtastning - d.v.s at der kan indtastes cprnr i kolonne A og data vedr. dette placeres i B - D i samme række - eller?

Jeg tror heller ikke det er helt så svært, men det er alligevel ikke lykkedes mig at finde en løsning.

-

Der vil kun kunne indtastes data i A1 - D1 (A1 hvis CPR ikke findes i DB i forvejen, ellers kun i B1 - D1, A1 behøver ikke være låst). Dvs. at der ikke er brug for meget fleksibilitet, men udelukkende referencer til felterne A1-D1 og A2.

Har skrevet det meste af kode - får den færdig snarest...

Et spørgsmål

Er formålet ajf. af poster i databasen, hvor Excel så "kun" anvendes som pladsholder?

Hvis det er tilfældet - så kunne en Userform måske være lidt mere hensigtsmæssig.

Indtast cprnr i A2 - data vises i B1 - D1

DB-felter: felt 0: Cprnr / 1: Navn / 2: Adresse / 3: Postnr

Reference indsættes i VBA/Excel Microsoft DAO 3.6

Koden i Ark1:
=============
Rem Database-def.
Public db As database, tbl_stamdata
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 åbnDatabase()
    findSti
    Set db = OpenDatabase(xSti + "database.mdb")
End Sub
Public Sub åbnStamdataTabel()
    åbnDatabase
    Set tbl_stamdata = db.OpenRecordset("Stamdata")
End Sub
Public Sub LukDb()
    On Error Resume Next
   
    tbl_stamdata.Close
    db.Close
End Sub
Public Function findCprNr(cprNr)
On Error GoTo fejl

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

On Error Resume Next

Rem Kolonne A2 - CprNr som søgekriterie
    If Not Intersect(Target, Range("A2")) Is Nothing Then
        flag = True
        aktuelleCprNr = CStr(Target.Value)
       
        If findCprNr(aktuelleCprNr) = True Then
            indsætDataFraDB Target.Row
        Else
            If Target.Value <> "" Then
                sv = MsgBox("CprNr.: " & CStr(Target.Value) & " kan ikke findes - oprettes?", vbYesNo)
                If sv = 6 Then
                    opretCprNr (aktuelleCprNr)
                End If
            End If
        End If
    Else
Rem Kolonne B - C - D
        If Not Intersect(Target, Range("B1:D1")) Is Nothing Then
            If flag = False Then
                aktuelleCprNr = CStr(Range("A2"))
           
                aktuelleKolonne = Target.Column
                aktuelleRække = Target.Row
                aktuelleVærdi = Cells(aktuelleRække, aktuelleKolonne)
                feltnr = aktuelleKolonne - 1
             
                opdaterStamdata feltnr, aktuelleVærdi
            End If
        End If
    End If
   
End Sub
Private Sub opretCprNr(cprNr)
    With tbl_stamdata
        .AddNew
        .Fields(0) = cprNr
        .Update
    End With
End Sub
Private Sub opdaterStamdata(feltnr, værdi)
    With tbl_stamdata
        .Edit
        .Fields(feltnr) = værdi
        .Update
    End With
End Sub
Private Sub indsætDataFraDB(rækkeNr)
    With ActiveSheet
        For x = 1 To 3
            .Cells(1, x + 1) = tbl_stamdata.Fields(x)
        Next x
    End With
   
    flag = False
End Sub
Private Sub Worksheet_Deactivate()
    LukDb
End Sub

Tusind tak for dit enorme arbejde. Jeg har ikke helt kunne få den til at virke, så jeg har lige et par yderligere spørgsmål.

- "DB-felter: felt 0: Cprnr / 1: Navn / 2: Adresse / 3: Postnr"
Er det navnene på kolonnerne i DB du nævner? Hvis ja, er navnet "0: cprNr/..." eller "0/1/2..."?

- ".Index = "primarykey" "
skal der sættes noget ind i stedet for "primarykey"?

- "Public Sub åbnStamdataTabel()
    åbnDatabase
    Set tbl_stamdata = db.OpenRecordset("Stamdata")
  End Sub"
Skal der ændres noget i denne Sub? Den ser nemlig ikke ud til at virke.

Felter i databasen kan enten tilgås ved deres feltnavn eller løbenrnummer (fra felt 0 - 240).

I min kode er CprNr=primaryKey

Stamdata er tabellens navn

----
ellers..
Send en mail (min adr. under profil) så sender jeg såvel DB som regneark.

Afslutning af denne runde?

Tak til supertekst fin hjælpen