08. marts 2009 - 11:55
Der er
3 kommentarer og
1 løsning
Forbindelse mellem excel og access
Jeg har en Access database med nogle informationer i en tabel.
Når jeg åbner min excelfil kan jeg godt finde ud af at hente data fra denne database.
Men jeg kunne rigtig godt tænke mig at denne forbindelse går begge veje, sådan at når jeg retter i direkte i excel i de data jeg lige har modtaget fra access, så bliver de også rettet i access.
På den måde kan jeg nøjes med at rette i dataene et sted, nemlig i excel.
Kan det overhoved lade sig gøre?
18. januar 2010 - 21:32
#4
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
