• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Userform afsluiten vraagstelling 'gegevens opslaan?'

Status
Niet open voor verdere reacties.

carloschouw

Gebruiker
Lid geworden
15 jun 2015
Berichten
225
Goedemorgen,

Ik heb een vraag over een mogelijkheid in een userform wanneer de userform gesloten wordt;

Ik heb een userform met een commandbutton <opslaan> Het gebeurt wel eens dat men gegevens invuld in de userform maar de <opslaan> knop vergeet, gevolg -> gegevens worden niet weggeschreven. Nu dacht ik dat het misschien handiger was om geen gebruik te maken van een <opslaan> knop maar de functie 'opslaan' te activeren wanneer de userform afgesloten wordt.

Wanneer men de userform afsluit er een msgbox komt met de vraag: gegevens opslaan J/N? Knop J = activeren gegevens verwerken, knop N = afsluiten zonder opslaan.

Weet iemand is dit mogelijk is en zo ja, hoe?
 
Dat kan je doen in deze Sub:
Code:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    [COLOR="#008000"]'CloseMode 0 = "Afgesloten via kruisje"[/COLOR]
    [COLOR="#008000"]'CloseMode 1 = "Afgesloten via Unload Me Of Unload Userform naam"[/COLOR]
    [COLOR="#008000"]'Zet bij niet afsluiten: Cancel = True[/COLOR]

    Select Case MsgBox("Gegevens opslaan?", vbYesNoCancel, "Formulier sluiten")
        Case vbYes
            [COLOR="#008000"]'Activeren gegevens verwerken[/COLOR]
        Case vbNo
            [COLOR="#008000"]'Afsluiten zonder opslaan[/COLOR]
        Case vbCancel
            Cancel = True
    End Select
End Sub
 
Laatst bewerkt:
Dank voor je hulp!

Ik heb de code getest en werkt prima! Enige wat mij niet lukt


Code:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    Select Case MsgBox("Gegevens opslaan?", vbYesNoCancel, "Formulier sluiten")
        Case vbYes
            'Hier voeg ik mijn code toe om de gegevens te verwerken
        Case vbNo
           
        Case vbCancel
            Cancel = True
    End Select
End Sub

Wanneer ik op 'JA' klik dan worden mijn gegevens niet verwerkt maar verdwijnt de msgbox zonder verdere verwerking van de data. Doe ik iets verkeerd?

De code die ik verwerk bevat een trigger (verplicht in te vullen veld), code begint zo:
Code:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    Select Case MsgBox("Gegevens opslaan?", vbYesNoCancel, "Formulier sluiten")
        Case vbYes

Dim iRow As Long
Dim ws As Worksheet

Dim lrow As Long
Dim lCount As Long
    
Set ws = Worksheets("Blad1")

ActiveSheet.ListObjects(1).AutoFilter.ShowAllData

Range("B5").Select

iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

If Trim(Me.TextBox1.Value) = "" Then
 Me.TextBox1.SetFocus
 MsgBox "Bla Bla Bla", vbOKOnly + vbInformation, "Bla Bla"
 Exit Sub
  End If


        Case vbNo
           
        Case vbCancel
            Cancel = True
    End Select
End Sub

(Uiteraard na de End If volgt de rest van de code) Dit is slechts deel van de code die dient als een voorbeeld, mogelijk geeft dit een conflict?)
 
Laatst bewerkt:
Ik zie daar ook geen code staan.
 
Dat is niet te lezen zo. Je kan je makkelijker zo doen.
Code:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    Select Case MsgBox("Gegevens opslaan?", vbYesNoCancel, "Formulier sluiten")
        Case vbYes
            [COLOR="#FF0000"]Call JouwSUB[/COLOR]

        Case vbNo
           
        Case vbCancel
            Cancel = True
    End Select
End Sub

Als het dan nog niet werkt kan je simpel in debug mode met F8 volgen waar het mis gaat.
 
Excuses, had mijn code 'geknipt' toegevoegd. Hier is mijn totale code voor deze functionaliteit.

Waar ik niet uitkom -> Wanneer ik bij afsluiten van de Userform op 'opslaan Ja' klik komt er eerst de Trim naar voren 'MsgBox "Nummer invullen", vbOKOnly + vbInformation, "Nummer"', dat werkt goed. Klik ik op die MsgBox (<OK> button) om het nummer in te vullen, dan kan dat niet want de Userform wordt n.l. afgesloten i.p.v. dat ik verder kan met het invullen van het formulier.

Na de Trim (check of TextBox1 is ingevuld of niet), in dit geval heb ik het niet ingevuld om de functionaliteit te testen, verdwijnt de Userform. Wanneer ik de TextBox1 vooraf WEL invul werkt het verder prima.

De 'fout' zit hem dus in de TextBox1 ingevuld J/N code. Daar kom ik niet uit om dit op te lossen. Heb jij een idee?


Code:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
          
Dim iRow As Long
Dim ws As Worksheet

Dim lrow As Long
Dim lCount As Long
    

    Select Case MsgBox("Gegevens opslaan?", vbYesNoCancel, "Formulier sluiten")
        Case vbYes

Set ws = Worksheets("Blad1")

ActiveSheet.ListObjects(1).AutoFilter.ShowAllData

Range("B5").Select

iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

If Trim(Me.TextBox1.Value) = "" Then
 Me.TextBox1.SetFocus
 MsgBox "Nummer invullen", vbOKOnly + vbInformation, "Nummer"
 Exit Sub
  End If

ws.Cells(iRow, 1).Value = Me.TextBox1.Value
ws.Cells(iRow, 2).Value = Me.ComboBox2.Value
ws.Cells(iRow, 3).Value = Me.ComboBox3.Value
ws.Cells(iRow, 4).Value = Me.TextBox4.Value
ws.Cells(iRow, 5).Value = Me.TextBox5.Value
ws.Cells(iRow, 6).Value = Me.TextBox6.Value
ws.Cells(iRow, 7).Value = Me.TextBox7.Value
ws.Cells(iRow, 8).Value = Me.ComboBox8.Value
ws.Cells(iRow, 9).Value = Me.TextBox9.Value
ws.Cells(iRow, 10).Value = Me.TextBox10.Value
ws.Cells(iRow, 11).Value = Me.TextBox11.Value
ws.Cells(iRow, 12).Value = Me.TextBox12.Value
ws.Cells(iRow, 13).Value = Me.TextBox13.Value
ws.Cells(iRow, 14).Value = Me.ComboBox14.Value
ws.Cells(iRow, 15).Value = Me.TextBox15.Value
ws.Cells(iRow, 16).Value = Me.TextBox16.Value
ws.Cells(iRow, 17).Value = Me.CheckBox17.Value
ws.Cells(iRow, 18).Value = Me.TextBox18.Value
ws.Cells(iRow, 19).Value = Me.Label1.Caption
ws.Cells(iRow, 20).Value = Me.Label2.Caption
ws.Cells(iRow, 21).Value = Me.Label3.Caption
ws.Cells(iRow, 22).Value = Me.Label4.Caption
ws.Cells(iRow, 23).Value = Me.Label5.Caption
ws.Cells(iRow, 24).Value = Me.Label6.Caption
ws.Cells(iRow, 25).Value = Me.Label7.Caption
ws.Cells(iRow, 26).Value = Me.TextBox33.Value
ws.Cells(iRow, 27).Value = Me.TextBox34.Value
ws.Cells(iRow, 28).Value = Me.ComboBox35.Value
ws.Cells(iRow, 29).Value = Me.ComboBox36.Value
ws.Cells(iRow, 30).Value = Me.ComboBox37.Value
ws.Cells(iRow, 31).Value = Me.CheckBox38.Value
ws.Cells(iRow, 32).Value = Me.TextBox39.Value
ws.Cells(iRow, 33).Value = Me.TextBox40.Value
ws.Cells(iRow, 34).Value = Me.TextBox41.Value

     TextBox1.Enabled = True
Me.TextBox1.SetFocus
     TextBox1.Enabled = False

    ActiveWorkbook.Worksheets("Blad1").ListObjects("Tabel1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Blad1").ListObjects("Tabel1").Sort.SortFields.Add _
        Key:=Range("Tabel1[[#All],[Nummer]]"), SortOn:=xlSortOnValues _
        , Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Blad1").ListObjects("Tabel1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    For lrow = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        lCount = lCount + 1
        If Cells(lrow, "A") = Cells(lrow, "A").Offset(-1, 0) Then
            Cells(lrow, "A").Offset(-1, 0).EntireRow.Delete
        End If
         
    Next lrow
        
    Range("A1").Select
       
     ActiveSheet.Protect Password:="0000", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
        
        Case vbNo

        Case vbCancel
            Cancel = True

    End Select

End Sub
 
Als je je document plaatst kan ik er vanavond wel even naar kijken.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan