Formulier wijzigingen opslaan

HWV · 27 dec 2009

Beste,

Om een patiënten bestand te maken voor een stichting voor eetstoornissen loop ik tegen een probleem aan.
Ik heb een kleine database ( moet nog uitgebreid worden tot ongeveer 60 kolommen )
waar ik de gegevens gaat bijhouden van de patiënten. Het opvragen en een nieuwe maken gaat wel lukken. Enkel hoe krijg ik het voor elkaar om de wijziging die ik maak in het formulier op te slaan op de juiste plek in de database.

In de bijlage een voorbeeld van tot hoever ik ben gekomen, ik weet er moet nog een hoop gebeuren en hoop dan ook dat u mij hiermee kunt helpen.

groet HWV

Hoornvan · 27 dec 2009

Beste,

Het opvragen en een nieuwe maken gaat wel lukken. Enkel hoe krijg ik het voor elkaar om de wijziging die ik maak in het formulier op te slaan op de juiste plek in de database.

Dit gaat eigenlijk het zelfde als met een nieuwe maken.
Het enige verschil, je moet nu de naam zoeken (Find) en dan op die regel de gegevens plakken.
Ik denk dat je dit wel hier in de database van helpmij kunt vinden.
Suc6

Hoornvan · 27 dec 2009

Kijk hier maar eens.

danny147 · 27 dec 2009

Beste HWV

We hebben destijds een bestandje gemaakt met een paar collega's van het forum.

Hier in dit bestandje zal je zeker je antwoord vinden.

Desnoods horen we het wel van U.

Groetjes Danny. :thumb:

HWV · 27 dec 2009

Code aanpassen lukt niet

Code:

Private Sub CmdWijzig_Click()
    Dim lrij As Long
    With Worksheets(1).Range("A1:A65536")
    Set WA = .Find(Cbo_Product.Value, LookIn:=xlValues, LookAt:=xlWhole)
    WA.Select
    Cells(WA.Row, "B").Value = Frm_Adres.Txt_Voorletters.Value
    End With

End Sub

Ik heb de code aangepast, maar loop tegen het volgende aan.
Set WA herkend hij niet (logies) maar ik zou niet weten hoeik het moet defineren.
Graag enige hulp hierbij gewenst

groet HWV

HWV · 27 dec 2009

Code:

Private Sub CmdWijzig_Click()

  On Error Resume Next
    Dim oRng As Range
    Set oRng = Sheets("DataBase").Cells.Find(what:=Cbo_Product.Value, LookAt:=xlWhole)
        If oRng <> "" Then

            ComboBox1.Value = oRng.Offset(0, 2).Value
            oRng.Offset(0, 0).Value = Txt_Debiteurennummer.Value
            oRng.Offset(0, 1).Value = Txt_Voorletters.Value
            oRng.Offset(0, 2).Value = Txt_Naam.Value
            oRng.Offset(0, 3).Value = Txt_Adres.Value
            oRng.Offset(0, 4).Value = Txt_Postcode.Value
            oRng.Offset(0, 5).Value = Txt_Plaats.Value
            oRng.Offset(0, 7).Value = Com_Geslacht.Value
            
        Else
            Txt_Debiteurennummer.Value = ""
            Txt_Voorletters.Value = ""
            Txt_Naam.Value = ""
            Com_Geslacht.Value = ""
            Txt_Adres.Value = ""
            Txt_Postcode.Value = ""
            Txt_Plaats.Value = ""


        End If

End Sub

IK heb de code omgedraaid, zoals Hoorvan al aan gaf.
Het is veel script het werkt wel , maar kan dit makkelijker ?

Groet HWV

Roncancio · 27 dec 2009

Ik heb in het formulier een knop geplaatst die de voorletters in het bestand plaatst.
Ik zou de tekstvelden op het formulier blokkeren zodat men daar niet in gaat rommelen.

Met vriendelijke groet,

Roncancio

danny147 · 27 dec 2009

Beste HWV

Zie bestandje met de code van Hoornvan en met een knopje wijzigen.

Groetjes Danny. :thumb:

HWV · 27 dec 2009

Zo dat werkt

Beste,

Bedankt voor het mee denken hierin, het is gelukt en werkt perfect.
Ik ga verder bouwen aan dit project en hoop zodra ik wat tegen kom waar ik niet uitkom jullie om raad mag vragen.
Misschien wijs om de vraag niet op opgelost tezetten, want er zullen ongetwijfeld nog vragen komen of jullie moeten hier anders over denken

Groet HWV

HWV · 28 dec 2009

sheets selecteren

Code:

Private Sub CmdWijzig_Click()
On Error GoTo Err_Knop1_Click

Dim stDocName As String
    Dim bytDoorgaan As Variant
bytDoorgaan = MsgBox("Wilt u de wijzigingen opslaan ? ", vbYesNo + vbDefaultButton2 + vbExclamation, "Attentie")

If bytDoorgaan = vbYes Then

[COLOR="Red"]Sheets("Database").Select[/COLOR]

    Dim lrij As Long
    Dim WA As Variant
    With Worksheets(1).Range("A1:A65536")
    Set WA = .Find(Cbo_Product.Value, LookIn:=xlValues, LookAt:=xlWhole)
    Cells(WA.Row, "B").Value = Frm_Adres.Txt_Voorletters.Value
    Cells(WA.Row, "C").Value = Frm_Adres.Txt_Naam.Value
    Cells(WA.Row, "D").Value = Frm_Adres.Txt_Adres.Value
    Cells(WA.Row, "E").Value = Frm_Adres.Txt_Postcode.Value
    Cells(WA.Row, "F").Value = Frm_Adres.Txt_Plaats.Value
    Cells(WA.Row, "H").Value = Frm_Adres.Com_Geslacht.Value
    Cells(WA.Row, "N").Value = Frm_Adres.Txt_Datum.Value
    
    End With
    
[COLOR="red"]Sheets("Leeg").Select[/COLOR]

Velden_Leeg_Maken ' Sub Velden_Leeg_Maken

End If
Exit_Knop1_Click:
Exit Sub

Err_Knop1_Click:
MsgBox Err.Description
Resume Exit_Knop1_Click
End Sub

Beste,

Ik heb de code hierboven om een wijziging door te voeren.
Enkel ging hij naar een verkeerde sheet wegschrijven. Ik heb het nu met de rode tekst opgelost maar waarschijnlijk niet de juiste manier.
Hoe kan ik dit juist in de code verwerken.

Groet HWV

Warme bakkertje · 28 dec 2009

Code:

Private Sub CmdWijzig_Click()
On Error GoTo Err_Knop1_Click

Dim stDocName As String
    Dim bytDoorgaan As Variant
bytDoorgaan = MsgBox("Wilt u de wijzigingen opslaan ? ", vbYesNo + vbDefaultButton2 + vbExclamation, "Attentie")

If bytDoorgaan = vbYes Then
    Dim lrij As Long
    Dim WA As Variant
    With Sheets("Database").Range("A1:A65536")
    Set WA = .Find(Cbo_Product.Value, LookIn:=xlValues, LookAt:=xlWhole)
    Cells(WA.Row, "B").Value = Frm_Adres.Txt_Voorletters.Value
    Cells(WA.Row, "C").Value = Frm_Adres.Txt_Naam.Value
    Cells(WA.Row, "D").Value = Frm_Adres.Txt_Adres.Value
    Cells(WA.Row, "E").Value = Frm_Adres.Txt_Postcode.Value
    Cells(WA.Row, "F").Value = Frm_Adres.Txt_Plaats.Value
    Cells(WA.Row, "H").Value = Frm_Adres.Com_Geslacht.Value
    Cells(WA.Row, "N").Value = Frm_Adres.Txt_Datum.Value
    
    End With
    
Sheets("Leeg").Select

Velden_Leeg_Maken ' Sub Velden_Leeg_Maken

End If
Exit_Knop1_Click:
Exit Sub

Err_Knop1_Click:
MsgBox Err.Description
Resume Exit_Knop1_Click
End Sub

HWV · 28 dec 2009

Gaat nog verkeerd wegschrijven

Beste rudi,

Bedankt voor jou reactie.
Met jou code blijf hij wegschrijven in het blad waar ik op dat moment staat in mijn geval sheets leeg.
Ik krijg het bestandje helaas hier niet geplaats ivm dat hij dan net te groot is als hij is ingepakt.
Met de optie van mij :

Code:

Private Sub CmdWijzig_Click()
On Error GoTo Err_Knop1_Click

Dim stDocName As String
    Dim bytDoorgaan As Variant
bytDoorgaan = MsgBox("Wilt u de wijzigingen opslaan ? ", vbYesNo + vbDefaultButton2 + vbExclamation, "Attentie")

If bytDoorgaan = vbYes Then

Sheets("Database").Select

    Dim lrij As Long
    Dim WA As Variant
    With Worksheets(1).Range("A1:A65536")
    Set WA = .Find(Cbo_Product.Value, LookIn:=xlValues, LookAt:=xlWhole)
    Cells(WA.Row, "B").Value = Frm_Adres.Txt_Voorletters.Value
    Cells(WA.Row, "C").Value = Frm_Adres.Txt_Naam.Value
    Cells(WA.Row, "D").Value = Frm_Adres.Txt_Adres.Value
    Cells(WA.Row, "E").Value = Frm_Adres.Txt_Postcode.Value
    Cells(WA.Row, "F").Value = Frm_Adres.Txt_Plaats.Value
    Cells(WA.Row, "H").Value = Frm_Adres.Com_Geslacht.Value
    Cells(WA.Row, "N").Value = Frm_Adres.Txt_Datum.Value
    
    End With
    
Sheets("Leeg").Select

Velden_Leeg_Maken ' Sub Velden_Leeg_Maken

End If
Exit_Knop1_Click:
Exit Sub

Err_Knop1_Click:
MsgBox Err.Description
Resume Exit_Knop1_Click
End Sub

Schrijf hij wel in de juiste sheet weg, ik had iets dergelijks wat jij mij aangaf ook geprobeerd en met het resultaat dat hij weg shrijf in de active map.

groet Henk

Warme bakkertje · 28 dec 2009

Code:

Private Sub CmdWijzig_Click()
On Error GoTo Err_Knop1_Click
If MsgBox("Wilt u de wijzigingen opslaan ? ", vbYesNo + vbDefaultButton2 + vbExclamation, "Attentie") = vbYes Then
    Dim WA As Integer
    With Sheets("Database")
    Set WA = .Columns(1).Find(Cbo_Product.Value, LookIn:=xlValues, LookAt:=xlWhole)
        .Cells(WA.Row, "B").Value = Frm_Adres.Txt_Voorletters.Value
        .Cells(WA.Row, "C").Value = Frm_Adres.Txt_Naam.Value
        .Cells(WA.Row, "D").Value = Frm_Adres.Txt_Adres.Value
        .Cells(WA.Row, "E").Value = Frm_Adres.Txt_Postcode.Value
        .Cells(WA.Row, "F").Value = Frm_Adres.Txt_Plaats.Value
        .Cells(WA.Row, "H").Value = Frm_Adres.Com_Geslacht.Value
        .Cells(WA.Row, "N").Value = Frm_Adres.Txt_Datum.Value
    End With
Application.Goto [Leeg!A1]
Velden_Leeg_Maken ' Sub Velden_Leeg_Maken
End If
Exit_Knop1_Click:
Exit Sub
Err_Knop1_Click:
MsgBox Err.Description
Resume Exit_Knop1_Click
End Sub

HWV · 28 dec 2009

Gelukt

Rudi,

Ik heb een stukje moeten aanpassen :

Code:

Dim WA As Integer

veranderd naar

Code:

Dim WA As Variant

Het werkt nu perfect bedankt

groet Henk

HWV · 28 dec 2009

Verhuizen van data

Code:

Sub Wegschrijven()
  For Each cl In Sheets("DataBase").Range("L2:L30000")
    If cl > 180 Then Sheets("Opslag").Cells(Rows.Count, 1).End(xlUp).Offset(1).EntireRow = cl.EntireRow.Value
  Next
End Sub

Ik probeer een actie erin te bouwen om 180 dagen na uitbehandeld te zijn dat deze dan gefilterd worden naar een andere sheet.En deze met de tijd nog te laten versturen via e-mail naar de desbetreffende behandelaar

Ik heb in de database een kolom toegevoegd met een formule om de dagen te tellen

Code:

=ALS((K2-J2)>0;K2-J2;" ")

Met de code VBA gaat het goed met dank aan SNB.
Nu wil ik enkel dat als er boven de 180 dagen komt dat hij dan pas gaat "verhuizen" nu gaat hij alles boven 0 verzhuizen.

Met de > teken geef ik toch al op dat hij alles boven de 180 moet nemen ?

Heeft iemand een idee hierover

Groet HWV

Warme bakkertje · 28 dec 2009

Probeer 'm zo eens

Code:

Sub Wegschrijven()
  For Each cl In Sheets("DataBase").Range("L2:L30000")
    If cl[COLOR="Red"].Value [/COLOR]> 180 Then Sheets("Opslag").Cells(Rows.Count, 1).End(xlUp).Offset(1).EntireRow = cl.EntireRow.Value
  Next
End Sub

HWV · 28 dec 2009

Perfect

Rudi, bedankt weer hij doet het

Groet Henk

danny147 · 28 dec 2009

Beste HWV

Kan je de vraag dan op opgelost zetten, onderaan rechts.

Groetjes Danny. :thumb:

HWV · 31 dec 2009

Button zichtbaar maken als veld gevuld wordt

Code:

Private Sub CmdWijzig_Click()

    On Error Resume Next

[COLOR="Red"]If Com_Uitbehandeld > 0 Then
CmdWijzig.Visible = True
 Exit Sub[/COLOR] 
    ElseIf Txt_Debiteurennummer = "" Then
        MsgBox "Om een nieuwe adres toe te voegen klikt U op NIEUW ", vbExclamation, "Voorletters."
        
Velden_Leeg_Maken
    
    Exit Sub

    ElseIf Txt_Voorletters = "" Then
        MsgBox "Gelieve voorletters in te geven ", vbExclamation, "Voorletters."
        Txt_Voorletters.SetFocus
    Exit Sub
    ElseIf Txt_Naam = "" Then
        MsgBox "Gelieve een naam in te geven ", vbExclamation, "Naam"
        Txt_Naam.SetFocus
    Exit Sub
    ElseIf Txt_Adres = "" Then
        MsgBox "Gelieve een adres in te vullen", vbExclamation, "Adres"
        Txt_Adres.SetFocus
    Exit Sub
    ElseIf Txt_Postcode = "" Then
        MsgBox "Gelieve een postcode in te vullen", vbExclamation, "Postcode"
        Txt_Postcode.SetFocus
    Exit Sub
    ElseIf Txt_Plaats = "" Then
        MsgBox "Gelieve een plaats in te vullen", vbExclamation, "Plaats"
        Txt_Plaats.SetFocus
    Exit Sub
    ElseIf Com_Geslacht = "" Then
        MsgBox "Gelieve een geslacht in te vullen", vbExclamation, "Geslacht"
        Com_Geslacht.SetFocus
    Exit Sub
    ElseIf Com_Uitbehandeld = "" Then
        MsgBox "Gelieve aan te geven uitbehandeld Ja of Nee", vbExclamation, "Uitbehandeld Ja of Nee"
        Com_Uitbehandeld.SetFocus
    Exit Sub

    Else

On Error GoTo Err_Knop1_Click
If MsgBox("Wilt u de wijzigingen opslaan ? ", vbYesNo + vbDefaultButton2 + vbExclamation, "Attentie") = vbYes Then
        Dim WA As Variant
    With Sheets("Database")
    Set WA = .Columns(1).Find(Cbo_Product.Value, LookIn:=xlValues, LookAt:=xlWhole)
        .Cells(WA.Row, "A").Value = Frm_Adres.Txt_Debiteurennummer.Value
        .Cells(WA.Row, "B").Value = Frm_Adres.Txt_Voorletters.Value
        .Cells(WA.Row, "C").Value = Frm_Adres.Txt_Naam.Value
        .Cells(WA.Row, "D").Value = Frm_Adres.Txt_Adres.Value
        .Cells(WA.Row, "E").Value = Frm_Adres.Txt_Postcode.Value
        .Cells(WA.Row, "F").Value = Frm_Adres.Txt_Plaats.Value
        .Cells(WA.Row, "H").Value = Frm_Adres.Com_Geslacht.Value
        .Cells(WA.Row, "N").Value = Frm_Adres.Txt_Datum.Value
        .Cells(WA.Row, "L").Value = Frm_Adres.Com_Uitbehandeld.Value
        .Cells(WA.Row, "O").Value = Application.UserName
    End With
Application.Goto [Leeg!A1]
Velden_Leeg_Maken ' Sub Velden_Leeg_Maken
End If
Exit_Knop1_Click:
Exit Sub
Err_Knop1_Click:
MsgBox Err.Description
Resume Exit_Knop1_Click
    End If

End Sub

Beste,

Ik probeer dit bestand voor de stichting zo duidelijk en uitgebreid mogelijk te maken, maar kan dit niet allleen daarom heb ik de vraag open laten staan.
Ik bovenstaande code tot nu toe, wat perfect werkt.
nu wil ik als "Com_Uitbehandeld" is gevuld dat ze dan pas op de knop wijzigen kunnen klikken.(Cmd_Wijzig) Dus bij opstarten van het formulier moet de knop onzichtbaar zijn en als pas de combobox Com_Uitbehandeld is gevuld dat hij weer zichtbaar wordt.

Ik krijg het niet voor elkaar,

Groet HWV

Warme bakkertje · 31 dec 2009

Code:

Private Sub UserForm_Initialize()
 CmdWijzig.Visible = False
End Sub

Code:

Private Sub Com_Uitbehandeld_AfterUpdate()
CmdWijzig.Visible = IIf(Com_Uitbehandeld > 0, True, False)
End Sub

Formulier wijzigingen opslaan

Terugkerende gebruiker

Bijlagen

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Meubilair

Bijlagen

Terugkerende gebruiker

Bijlagen

Terugkerende gebruiker

Terugkerende gebruiker

Meubilair

Terugkerende gebruiker

Meubilair

Terugkerende gebruiker

Terugkerende gebruiker

Meubilair

Terugkerende gebruiker

Terugkerende gebruiker

Terugkerende gebruiker

Meubilair

Wij waarderen jouw privacy