Hey,
For my schoolwork I have to make an combination of something that works
with excel, vba and access. It's almost finished now and newt week I
have to hand it in, but my teacher want's me to implement one crucial
thing. The records in my database must only appear once. So when a user
types something into my userform it should overwrite the existing data
instead of making a whole new row in my table.
Maybe it would be interesting that I also get a messagbox asking if he
really wants tot update the record or if he want's to leave the form
and do nothing.
Can someone help me with that. I think I need an update query but don't
know how that works. I have to do this in different forms, so I give
the code of one of my forms. Maybe interesting is that you know that
in a sheet called "Toevoegen" all the tickersymbols (the name by which
my stocks are stored) are in row A.
I tried a loop but I think it's a mess and I should do it through SQL
or such ...
my code so far:
Option Explicit
Private Sub UserForm_initialize()
TekstTicker.Value = ""
TekstAandeel.Value = ""
TekstRente.Value = ""
TekstDiv.Value = ""
TekstGroeivoet.Value = ""
TekstBeta.Value = ""
TekstMarktrisico.Value = ""
TekstTicker.SetFocus
End Sub
Private Sub ComAnnuleren_Click()
Unload UserForm3
End Sub
Private Sub ComOK_Click()
Application.ScreenUpdating = False
Dim DB As DAO.Database
Dim RecSet As DAO.Recordset
Dim oEngine As DAO.DBEngine
Dim rs As DAO.Recordset
Dim Antwoord As Integer
Dim s_Path As String
Dim Dubbele_data As Integer
Dim Ticker As Variant
Dim sData1 As String
Dim lRowNum1 As Integer
Dim totalrows As Integer
Dim row As Integer
Dim i As Integer
Goto foutafhandeling:
'Controleren of alle gegevens ingevuld zijn en of er geen enkel vakje
leeggelaten wordt
If TekstAandeel = "" Or TekstRente = "" Or TekstTicker = "" Or
TekstDiv = "" Or TekstBeta = "" Or TekstMarktrisico = "" Then
Antwoord = MsgBox("Niet alle gegevens zijn ingevuld. Gelieve alle
gegevens correct in te vullen.", vbOKOnly, "Waarschuwing ingegeven
data")
Else
' controle dubbele gegevens
For i = 1 To totalrows
Do While Cells(1, i).Value <> TekstTicker.Text
If Cells(1, i).Value = TekstTicker.Text Then
GoTo gevonden:
Else
i = i + 1
End If
Loop
Next i
s_Path = ActiveWorkbook.Path
s_Path = s_Path & "\Thesis.mdb"
Set DB = DAO.OpenDatabase(s_Path)
'Tickersymbool in werkblad Toevoegen gieten
sData1 = TekstTicker.Text
Sheets("Toevoegen").Activate
If Cells(1, 1).Value = "" Then
lRowNum1 = 1
Else
lRowNum1 = ActiveSheet.UsedRange.Rows.Count + 1
End If
Cells(lRowNum1, 1).Value = sData1
'Wissen van dubbele tickersymbolen in de lijst op het werkblad
Toevoegen
Cells.Sort Key1:=Range("A1")
totalrows = ActiveSheet.UsedRange.Rows.Count
For row = totalrows To 2 Step -1
If Cells(row, 1).Value = Cells(row - 1, 1).Value Then
Rows(row).Delete
End If
Next row
'Link maken met Access databank om gegevens en formules in op te
slaan
'ActiveX Data Objects (ADO) bibliotheek activeren
'Microsoft 3.x DAO Library aangevinkt
s_Path = ActiveWorkbook.Path
s_Path = s_Path & "\Thesis.mdb"
Set DB = OpenDatabase(s_Path)
Set rs = DB.OpenRecordset("DDM")
With rs
rs.AddNew
rs!Ticker = TekstTicker
rs!Aandeel = TekstAandeel
rs!Rente = TekstRente
rs!Dividend = TekstDiv
rs!Groeivoet = TekstGroeivoet
rs!Beta = TekstBeta
rs!Marktrisico = TekstMarktrisico
rs!Waarde_Aandeel = CDbl(TekstDiv) / (((CDbl(TekstRente) /
100) + (CDbl(TekstBeta) * (CDbl(TekstMarktrisico) / 100)) -
(CDbl(TekstGroeivoet) / 100)))
rs.Update
End With
Set rs = Nothing
Set DB = Nothing
Unload UserForm3
End If
gevonden:
MsgBox "Gevonden"
Einde:
Exit Sub
FoutAfhandeling:
If Err.Number = 3421 Then
MsgBox "Gelieve op de correcte plaats numerieke of waarden in te
geven"
Else
MsgBox "Een fout is opgetreden. Bij verdere problemen " & vbCr & "
kan u contact opnemen met de ontwerper van deze spreadsheet " & vbCr &
" op volgend adres:
(E-Mail Removed)."
End If
GoTo Einde
End Sub
Similar Threads
