Formulierveld ophogen met 1 bij openen van het formulier

Status
Niet open voor verdere reacties.
J

jodelo

Gebruiker
Lid geworden
13 sep 2007
Berichten
87
Beste forumleden:

Na het nodige zoekwerk om het ID veld van mijn userform automatisch te laten ophogen met het opvolgende nummer uit de database, heb ik volgende code in gebruik:

#Private Sub UserForm_Initialize()
Contacten.TextBox1 = Application.WorksheetFunction.Max(Range("A:A")) + 1
End Sub#

Als resultaat krijg ik nummer 1 in het veld te zien met alle bijbehorende data. (deze worden automatisch opgehaald uit de database i.v.m. het bewerken van records)
Graag zou ik zien dat het laatst gebruikte ID nummer wordt opgehoogd met 1 zodat ik niet twee keer hetzelfde nummer kan gebruiken.

Bijgevoegd het complete bestand zonder gevoelige data.
Hopelijk kan iemand mij helpen.

m.vr.gr.
Jo
 

Bijlagen

  • Adresboek.xlsm
    41,1 KB · Weergaven: 23
Laatst bewerkt:
Alle code is zonder inspringpunten geschreven.
Sorry, maar dat is geen lezen.

Daarnaast werkt die Max functie in de Userform_Initialize gewoon goed.
Die geeft hier een 3 terug.
 
Laatst bewerkt:
edmoor zei:
Alle code is zonder inspringpunten geschreven.
Sorry, maar dat is geen lezen.

Daarnaast werkt die Max functie in de Userform_Initialize gewoon goed.
Klik om te vergroten...

Hoi Edmoor:
Sorry voor de code, die kwam uit een ouder excel werkmap die ik gekopieerd heb, maar die stond er al op die manier in.
Zelf ben ik niet zo gevorderd om het inspringen op juiste manier uit te voeren.

Kan het zijn dat de max functie de waarde waarbij moet worden opgeteld niet van het werkblad "Data" haalt ??
 
Klopt. Je moet wel het blad Data actief hebben.
Of maak er dit van:
Code: 
Contacten.TextBox1 = Application.WorksheetFunction.Max(Sheets("Data").Range("A:A")) + 1
 
edmoor zei:
Klopt. Je moet wel het blad Data actief hebben.
Of maak er dit van:
Code: 
Contacten.TextBox1 = Application.WorksheetFunction.Max(Sheets("Data").Range("A:A")) + 1
Klik om te vergroten...

Dat is em Edmoor, heel hartelijk bedankt.
Ik zal zulke zaken toch echt zelf moeten gaan kunnen ontdekken.
Maar daarvoor hebben we natuurlijk dit prachtige forum, nogmaals bedankt en een fijne zondag.

gr. Jo
 
Hetzelfde gewenst.
En hierbij je code uit de module met de inspringpunten, verder niets aan gewijzigd:
Code: 
Dim id As Integer, i As Integer, j As Integer, flag As Boolean, ws As Worksheet

Sub GetData()
    Set ws = Worksheets("Data")
    If IsNumeric(Contacten.TextBox1.Value) Then
        flag = False
        i = 0
        id = Contacten.TextBox1.Value
        Do While ws.Cells(i + 1, 1).Value <> ""
            If ws.Cells(i + 1, 1).Value = id Then
                flag = True
                For j = 2 To 10
                    Contacten.Controls("TextBox" & j).Value = ws.Cells(i + 1, j).Value
                Next j
            End If
            i = i + 1
        Loop
        
        If flag = False Then
            For j = 2 To 10
                Contacten.Controls("TextBox" & j).Value = ""
            Next j
        End If
    Else
        ClearForm
    End If
End Sub

Sub ClearForm()
    For j = 1 To 10
        Contacten.Controls("TextBox" & j).Value = ""
    Next j
End Sub

Sub EditAdd()
    Dim emptyRow As Long
    
    Sheets("Data").Activate
    Application.ScreenUpdating = True
    If Contacten.TextBox1.Value <> "" Then
        flag = False
        i = 0
        id = Contacten.TextBox1.Value
        emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
        Do While Cells(i + 1, 1).Value <> ""
            If Cells(i + 1, 1).Value = id Then
                flag = True
                For j = 2 To 10
                    Cells(i + 1, j).Value = Contacten.Controls("TextBox" & j).Value
                Next j
            End If
            i = i + 1
        Loop
        
        If flag = False Then
            For j = 1 To 10
                Cells(emptyRow, j).Value = Contacten.Controls("TextBox" & j).Value
            Next j
        End If
    End If
    
    Call ClearForm
    Sheets("MENU").Activate
End Sub
 
Laatst bewerkt:
Dank je Edmoor, ik zal het aanpassen en bestuderen.

gr. Jo
 
Excel heeft ook zoekfuncties waardoor de hele loop onnodig is. Daarnaast kan je code beter direct in de module van het formulier zetten. Zoeken dmv Textbox1 kan ook rare resultaten opleveren.

Voor jouw hele project zijn maar een paar regels code nodig.
 

Bijlagen

  • Adresboek.xlsm
    40,8 KB · Weergaven: 28
Hoi VenA

Even jou aanpassing bekeken en het ziet er goed uit.
Heb vanavond weinig tijd en was vanmiddag niet meer thuis, maar ik ga het morgen eens even bekijken.

Bedankt voor jou bijdrage en hoop dat ik er weer iets wijzer van wordt.

m.vr.gr.
Jo
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan