102. Excel-VBA: Und es geht doch: Über eigene Funktionen auf Access zugreifen (Lesen+Schreiben)

In diesem Video zeige ich Dir ein Beispiel aus meinen Excel VBA IV-Kurs. Bei diesem Beispiel stelle ich Euch einige Funktionen vor, über die Ihr aus Excel auf Access-Daten zugreifen könnt. Dabei werden über einen eindeutigen Schlüssel ein dazugehöriger Preis aus einer Datenbank geholt. Das Besondere: Auch das Schreiben eines neuen Preises von Excel direkt in die Access-Tabelle ist bei dieser Technik möglich. Über eine Zelle könnt Ihr somit aktuelle Preise abrufen und neue Preise erfassen.
Weitere Angebote auf meiner Homepage:
-Das kostenlose, monatlich erscheinende VBA-Rundschreiben:
held-office.de/rundschreiben/
-Die VBA-Datenbank VBA-Tanker mit über 8.944 Prozeduren:
held-office.de/vba-repository/
-Aktuelles Kursangebot:
held-office.de/kurse/termine/

[@klausf4200]

Hallo Bernd, vielen Dank für die tolle Anregung! Auf dieser Basis mit einem funktionierendem Beispiel kann jeder dieses Vorgehen auf seine Bedürfnisse leicht anpassen. Sorry das ich erst jetzt hier vorbeigekommen bin, es kann schon eine Zeit dauern bis man die Leute erreicht😉 Bitte weiter so und vielen Dank fürs teilen.

[@vba-kracherheld-office]

Danke Klaus

[@markussch3835]

Sehr geil Bernd,
da kann man mal sehen, wofür ein Bier am Abend gut sein kann!
War wohl nix mit der "Pause" nach dem 100. Video, zu unserem Glück.

[@vba-kracherheld-office]

Ja, ein Bier am Abend kann schon weiterhelfen (-;

[@sifflord99]

Hey, versuche gerade dein Beispiel bei mir anzuwenden. Aber leider ist der Code von DatenZurueckschreiben an der Stelle abgebrochen im Video.
rst.Open "SELECT" FROM tbl_produkte WHERE Nr="&Range(strZelle).Value, objcon,
Wie geht es nach dem Komma weiter?

[@jackjacobus5621]

Habe das gleiche Problem wie Saif B. Gibt es eine Info über den fehlenden Teil von rst.Open "SELECT" FROM tbl_produkte WHERE Nr="&Range(strZelle).Value, objcon,?

[@puzzlekuchen]

Ich weis ich möchte ziemlich genau das machen, aber ich verstehe bisher leider nicht ansatzweise wie das alles funktioniert. Also komme ich später nochmal zurück^^

[@ralfanton7563]

Die Idee ist super, die Umsetzung aber noch ausbaufähig.
Was mich stört, sind die unnötigen Kommentare. Bei 10.000 DS hat man da richtig viel zu tun oder muss sich extra dafür noch ein Makro schreiben. Zumal die Kommentare ja auch noch Speicher und Performance kosten. Es geht auch ohne. Mit einer einzigen, öffentlichen Stringvariablen (ich nenne sie mal strFormel).
Im Bsp. liegt mein Datenbereich von A2:B4, wobei in Spalte B der Funktionsaufruf steht. Ich hab der Einfachheit halber mal einen SVerweis auf den Bereich D2:E4 genommen. In E stehen die zu lesenden bzw zu ändernden Werte. Das nur zum Verständnis des Codes.
Der Code im Tabellenmodul:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B4")) Is Nothing And Target.Cells.Count = 1 Then
Application.EnableEvents = False
Target.Offset(, 3) = Target.Value
Target = strFormel
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B4")) Is Nothing And Target.Cells.Count = 1 Then strFormel = Target.Formula
End Sub
Und im allg. Modul:
Public strFormel As String
Noch aktueller Nachteil, auf den ich hinweisen will ist, wenn mehrere Zellen markiert sind aber trotzdem die 1. Zelle des markierten Bereiches geändert wird, dann greift der Code nicht. Aber das kann sich ja der, der es will oder braucht, noch selbst einbauen. Als Exampel reicht der Code hier...:)
Trotzdem nochmal Danke für die Anregung!
Ralf Anton

[@vba-kracherheld-office]

Hi Anton, ja da hast Du recht. Eine globale Variable tut das gleiche und ist insgesamt speicherärmer, danke für den Tipp. Ist sozusagen der erste Ansatz gewesen. Vg Bernd

[@vba-kracherheld-office]

In der Zwischenzeit habe ich die Lösung über eine globale Variable umgesetzt. Funktoniert!

[@ralfanton7563]

@@vba-kracherheld-office In diesem Thread: www.office-loesung.de/p/viewtopic.php?f=166&t=830097
stieß Dein Vorschlag schon auf entsprechende Resonanz...:)
VG Ralf

[@vba-kracherheld-office]

@@ralfanton7563 Freut mich!

[@jackjacobus5621]

Hallo Bernd, Danke für die tolle Idee und Dein ausführliches Video.
Bin begeistert von Deiner Lösung.
Kannst Du bitte das fehlende Ende im Video mit anzeigen von
rst.Open "SELECT" FROM tbl_produkte WHERE Nr="&Range(strZelle).Value, objcon,
?
Vermutlich ist die DEMO Datei in den letzten Jahren gelöscht worden.

[@vba-kracherheld-office]

Hi Jack, ich poste mal den gesamten Quellcode.
Private Sub Worksheet_Activate()
Application.CellDragAndDrop = False
End Sub
Private Sub Worksheet_Deactivate()
Application.CellDragAndDrop = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.HasFormula Then
Target.ClearComments
Target.AddComment Target.Formula
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.NoteText "" Then
Application.EnableEvents = False
DatenZurueckschreiben Target
Target.Formula = Target.Comment.Text
Application.EnableEvents = True
End If
End Sub
'Hinter STandardmodul
Sub DatenZurueckschreiben(rngZelle As Range)
Dim strDB As String
Dim objCon As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strZelle As String
Dim intPosStart As Integer
Dim intPosEnde As Integer

strDB = ThisWorkbook.Path & "\Preise.accdb"
strZelle = rngZelle.Comment.Text
intPosStart = InStr(strZelle, "(")
intPosEnde = Len(strZelle)
strZelle = Mid(strZelle, intPosStart + 1, intPosEnde - intPosStart - 1)

Set objCon = New ADODB.Connection
objCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB
Set rst = New ADODB.Recordset

rst.Open "SELECT * FROM tbl_produkte WHERE Nr=" & Range(strZelle).Value, objCon, adOpenKeyset, adLockOptimistic
rst.Fields("Preis") = rngZelle.Value
rst.Update
Set rst = Nothing
objCon.Close
Set objCon = Nothing

End Sub
Function HoleInfo(rngZelle As Range) As Variant
'Microsoft ActiveX Data Objects - Bibliothek einbinden
Dim strDB As String
Dim objCon As ADODB.Connection
Dim rst As ADODB.Recordset
If rngZelle.Value = "" Then
HoleInfo = ""
Exit Function
End If
strDB = ThisWorkbook.Path & "\Preise.accdb"
Set objCon = New ADODB.Connection
objCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB
Set rst = New ADODB.Recordset
rst.Open "SELECT Preis FROM tbl_produkte WHERE Nr=" & rngZelle.Value, objCon, adOpenKeyset, adLockOptimistic
HoleInfo = rst.Fields("Preis")
rst.Close
Set rst = Nothing
objCon.Close
Set objCon = Nothing
End Function