Ich habe in Excel mehrere Tabellenblätter (12 Stück also eines für jeden Monat). Nun hole ich mir aus Access die Daten für die Tabelle per Verbindung.
Dann habe ich eine Funktion eingefügt die nach Änderung einer Zelle etwas macht.
Nun ändern sich die Zellen ja auch beim Aktualisieren der Daten. Da soll aber meine Überwach nicht drauf reagieren.
(Aktualisiert wird in Excel bei Daten>Alle Aktualisieren)
Ein weiteres Problem ist, dass die Prüfung ob der Eintrag erfolgreich war immer sagt, dass er nicht erfolgreich war, ob er es ist.
Hier stehen also genau die selben Werte.
Dann habe ich eine Funktion eingefügt die nach Änderung einer Zelle etwas macht.
Nun ändern sich die Zellen ja auch beim Aktualisieren der Daten. Da soll aber meine Überwach nicht drauf reagieren.
(Aktualisiert wird in Excel bei Daten>Alle Aktualisieren)
Ein weiteres Problem ist, dass die Prüfung ob der Eintrag erfolgreich war immer sagt, dass er nicht erfolgreich war, ob er es ist.
Hier stehen also genau die selben Werte.
Visual Basic-Quellcode
- MsgBox ("Fehler:") & vbCr & ("Die Daten wurden evtl. nicht in der Datenbank gespeichert.") & vbCr & ("Bitte selbst vergleich ob die Daten überinstimmen.") & vbCr & ("Das steht in der Datenbank: ") & rs.Fields(DBAttribut) & vbCr & ("Das wurde bei Excel eingegeben: ") & Range(UpdateFeld & c.Row), , ("Fehler beim Aktualisieren")
Visual Basic-Quellcode
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim SQLBack As String
- Dim DB As String
- Dim Tabelle As String
- Dim ID As String
- Dim UpdateFeld As String
- Dim DBAttribut As String
- DB = "\\XXX.accdb" 'Pfad der Datenbank
- Tabelle = "Begleitarbeiten_TL_Liste" 'Tabelle in der der Datensatz aktualisiert werden soll
- ID = "Y" 'In welcher Spalte die ID steht
- UpdateFeld = "L" 'In welcher Spalte das Feld ist was aktualisiert werden soll
- DBAttribut = "XXXX" 'So heißt das Feld in der Datenbank das aktualisiert wird
- Dim objDatabase As Object 'für SQL Update
- Dim sSQL As String 'für SQL Update
- Dim Rng As Range, c As Range 'für den Change
- Set Rng = Intersect(Target, Range(UpdateFeld & ":" & UpdateFeld)) 'nur in L wird auf Chance überwacht
- If Not Rng Is Nothing Then
- For Each c In Rng
- 'Cells(c.Row, 1).Value = "Changed"
- Dim strQuest As String
- strQuest = MsgBox("Soll der Namegeändert werden? " & vbCr & _
- "Wählen Sie jetzt...", vbYesNo + vbQuestion, "Name ändern")
- 'Wenn die Abfrage mit "Nein" bestätigt wird,
- 'wird die Prozedur mit dem Befehl "Exit Sub" abgebrochen.
- If strQuest = vbNo Then
- MsgBox ("Es wurde nichts geändert"), , ("Abbruch")
- Exit Sub
- End If
- 'Es wird geändert
- 'MsgBox ("Erkannt wurde Zeile: " & c.Row)
- 'MsgBox ("Aktualisiert wird: " & Range("B" & c.Row)) 'Wert aus Spalte B und Zeile c.Row
- sSQL = "UPDATE " & Tabelle & " SET " & DBAttribut & " = '" & Range(UpdateFeld & c.Row) & "' WHERE ID =" & Range(ID & c.Row)
- Set objDatabase = CreateObject("DAO.DBEngine.120").OpenDatabase(DB)
- objDatabase.Execute sSQL, 128
- 'Next
- 'MsgBox ("JETZT ÄNDERN")
- sSQL = "SELECT " & DBAttribut & " FROM " & Tabelle & " WHERE ID =" & Range(ID & c.Row)
- Dim rs As Object
- Set rs = objDatabase.Openrecordset(sSQL)
- 'MsgBox ("Ich weiß noch: " & Range(ID & c.Row))
- If Not rs.EOF Then ' Prüfung auf leeres Recordset
- 'MsgBox ("Jetzt prüfe ich Db Inhalt: ") & rs.Fields(DBAttribut) & vbCr & ("Mit Excel Zellenwert: ") & Range(UpdateFeld & c.Row)
- If rs.Fields(DBAttribut) = " & Range(UpdateFeld & c.Row) & " Then
- MsgBox ("Prüfung war erfolgreich. In der DB steht: ") & rs.Fields(DBAttribut)
- 'MsgBox ("In der DB steht: ") & rs.Fields(DBAttribut)
- Else
- MsgBox ("Fehler:") & vbCr & ("Die Daten wurden evtl. nicht in der Datenbank gespeichert.") & vbCr & ("Bitte selbst vergleich ob die Daten überinstimmen.") & vbCr & ("Das steht in der Datenbank: ") & rs.Fields(DBAttribut) & vbCr & ("Das wurde bei Excel eingegeben: ") & Range(UpdateFeld & c.Row), , ("Fehler beim Aktualisieren")
- End If
- End If
- Next
- End If
- End Sub