Automatisch met 1 ophogen formulier

[don42]

Hallo allen,

heb een formuliertje gemaakt
nu wil ik graag dat met invoer de nummers in kolom A
vanzelf met 1 ophogen.

is dit mogelijk

mijn "form'

Bekijk bijlage formulier2.xlsm

bvd
Don.

 

[HSV]

Misschien is dit wel iets.

Je textbox voor kasboeknummer heeft wel de naam 'txtVoornaam'.

Private Sub CommandButton1_Click()
With frmData
 .txtVoornaam = WorksheetFunction.Max(Sheets("Blad1").Columns(1), 0) + 1
 .Show
End With
End Sub

 

[edmoor]

Ik heb even snel gekeken wat handig zou zijn maar de code zoals je die in het form gebruikt is amper te lezen wegens het niet gebruiken van de juiste inspringpunten. Als ik iets als dit zie haak ik al snel af omdat niet te zien is welke End If nu bij welke If hoort en wat er in welke sectie precies iets gebeurd.

ActiveCell.End(xlDown).Offset(1, 0).Select
txtVoornaam.Text = ""
txtLastName.Text = ""
txtMobiel.Value = ""
End If
End If
End If

 

[HSV]

Ben het met je eens Ed, deze laat ik ook direct links liggen.
Vandaar dat ik maar snel naar de "show" van het form ben gegaan.

 

[don42]

HSV dit werk prima (1 x)
zou het kunnen als ik op invoer klik het volgende nummer komt?

Edmoor HSV, ik geloof je meteen, als beginneling heb ik de code stap voor stap gemaakt via een you tube
dat lukt aardig, uit een andere code de de foutmelding gezocht als een veld leeg bleef
weer een andere code voor als in het bovenste veld geen cijfers staan
en weer een code die er voor zorgde dat ik geen foutmelding kreeg bij de eerste invoer
heb daar lang aan gepruts tot het werkte (en dat doet het ook nog) maar geloof je meteen dat je nu tussen de bomen het bos niet meer ziet
heb hier alle begrip voor,

don

 

[HSV]

Zet onderstaande coderegel onder dat stukkie van @edmoor, en boven de 'End Sub'.

txtVoornaam = WorksheetFunction.Max(Sheets("Blad1").Columns(1), 0) + 1

 

[edmoor]

@don42:
Ik heb er dan ook alle begrip voor dat je nog geen inspringpunten gebruikt. Zie het maar als een leermomentje. Als je met alleen Youtube tot het huidige resultaat bent gekomen is dat sowieso een complimentje waard

Maar doe het dus altijd zo en gebruik de tabtoets voor de inspringpunten:

If conditie Then
    If andere_conditie Then    
        code
    End If
Else
    andere code
End If

Dat geldt voor alle conditionele code en maakt het een stuk leesbaarder, ook voor jezelf.
Daarnaast de tip om NOOIT een On Error Resume Next te gebruiken zonder zelf enige foutcontrole te doen. Wanneer je het toch wilt gebruiken, want daar kan een reden voor zijn, moet je het direct als het niet meer nodig is teniet doen met de volgende opdracht: On Error Goto 0

Zonder iets aan je code te wijzigen heb ik de inspringpunten aangebracht in de cmdSend_Click. Dit kun je als voorbeeld gebruiken en zie je ook dat het meteen een stuk leesbaarder en dus makkelijker te volgen is:

Private Sub cmdSend_Click()
    On Error Resume Next
    If IsNumeric(txtVoornaam.Text) = False Then
        MsgBox "Je moet hier cijfers invullen", vbExclamation, "Eerste invoer moet een getal zijn!"
        Exit Sub
    End If
 
    If Me.txtLastName.Value = "" Then
        MsgBox "Vul je voornaam in.", vbExclamation, "Informatie"
        Me.txtVoornaam.SetFocus
        Exit Sub
    End If

    If Me.txtMobiel.Value = "" Then
        MsgBox "Vul je achternaam in.", vbExclamation, "Informatie"
        Me.txtVoornaam.SetFocus
        Exit Sub
    Else
        If Range("A2").Value = ("") Then 'Tot aan Else is enkel om geen foutmelding te krijgen als de rij nog leeg is...
            Range("A1").Select 'de offset gaat naar deze kolom
            On Error Resume Next
            Range("A2").Value = txtVoornaam.Text
            Range("b2").Value = txtLastName.Text
            Range("c2").Value = txtMobiel.Text
            ActiveCell.End(xlDown).Offset(1, 0).Select
            txtVoornaam.Text = ""
            txtLastName.Text = ""
            txtMobiel.Value = ""
        Else
            On Error Resume Next
            If IsNumeric(txtVoornaam.Text) = False Then
                MsgBox "Je moet hier cijfers invullen", vbExclamation, "Eerste invoer moet een getal zijn!"
                Exit Sub
            End If
            
            If Me.txtLastName.Value = "" Then
                MsgBox "Vul je voornaam in.", vbExclamation, "Informatie"
                Me.txtVoornaam.SetFocus
                Exit Sub
            End If
 
            If Me.txtMobiel.Value = "" Then
                MsgBox "Vul je achternaam in.", vbExclamation, "Informatie"
                Me.txtVoornaam.SetFocus
                Exit Sub
            Else
                Range("A1").Select
                ActiveCell.End(xlDown).Select
                laatste = ActiveCell.Row
                'MsgBox laatste
                Cells(laatste + 1, 1).Value = txtVoornaam.Text
                Cells(laatste + 1, 2).Value = txtLastName.Text
                Cells(laatste + 1, 3).Value = txtMobiel.Text
                ActiveCell.End(xlDown).Offset(1, 0).Select
                txtVoornaam.Text = ""
                txtLastName.Text = ""
                txtMobiel.Value = ""
            End If
        End If
    End If
End Sub

 

[don42]

Dat ziet er goed uit

edmoor bedankt zeg
Ja dit is naturlijk veel beter zal er zeker mee gaan werken
verder heb ik (jullie) het voor elkaar wat ik vroeg

kijk eens:
Bekijk bijlage formulier3.xlsm

nu heb ik een code voor het sorteren van de 3 kolommen
het staat nu door , , , , , , , xlYes ( dat de bovenste cel - veldnamen niet mee doen)
met onderstaan de code zou zowel bovenste als onders rij niet mee doen
ik gebruik dit voor een opkomst lijst op mijn werk en onder aan staat dan Geen Vos aanwezig, (VOS = vak onder steuner)
dit zij ze zo gewend
mar je moet wel op voor of achternaam kunnen sorteren
nu weet ik niet of het komt door de laatste toevoegingen waar jullie mij mee geholpen hebben
of dat er een fout zit in de code maar het werkt in elk geval niet

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <= 3 Then Range("A1").Resize(Range("A1").End(xlDown).Offset(-1, 0).Row, 3).Sort Cells(1, Target.Column), , , , , , , xlYes
End Sub

don

 

[edmoor]

Met een knipoog

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column <= 3 Then
        Range("A1").Resize(Range("A1").End(xlDown).Offset(-1, 0).Row, 3).Sort Cells(1, Target.Column), , , , , , , xlYes
    End If
End Sub

Wat erg handig is bij dit soort dingen is een macro opname. Zet het opnemen aan (Tabblad Ontwikkelaars) en voer handmatig uit wat je wilt doen. Stop dan de opname en bekijk de code van de opgenomen macro. Dat kun je vaak direct overnemen om te gebruiken.

 

[don42]

handige tip

Dit forum is geweldig en de hulp en tips zij erg bruikbaar bewaar alle mail
de manier van macro opnemen en dan code bekijken ga ik zeker starks even testen,

met jou aanpassing werkt het sorteren
maar ja het zou ook eens niet...
nu wordt er onder aan de rij een nieuwe invoer gezet en deze sorteerd niet mee
(dat vroeg ik toch !) ja maar is niet de bedoeling wil de zelfde regel onder laten staan

Een paar dagen terug kwam dit uit jouw hoed

If ActiveSheet.Name <= 53 Then 'vanaf hier is de code zwarte streep
ActiveCell.Insert
Target.Offset(-1, 0).Interior.Color = vbBlack

om een streep te maken bij een verlofboek,
kan het niet dat de dat er eerste een extra rij wordt ingevoerd en vervolgens de nieuwe naam
zo blijft de onders regel behouden.

als ik dit voor elkaar heb hou ik me even rustig beloofd
dan heb ik weer genoeg voer voor het weekend.

Don

 

[Roncancio]

Macro opnemen kan handig zijn maar heeft de nodige nadelen.
Zo zie je relatieve verwijzingen die voor een leek moeilijker te lezen zijn en zie je onnodig veel code.
Bijvoorbeeld:

Een dunne rand om de huidige cel.

Sub Macro1()
'
' Macro1 Macro

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Hetzelfde resultaat maar dan een kortere code.

Sub Macro1()

ActiveCell.BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
End Sub

Bovenstaande code nog wat korter

Sub Macro1()

ActiveCell.BorderAround 1, 2, 1
End Sub

Met vriendelijke groet,


Roncancio

 

[don42]

Hoi
Sorry dat ik zo laat reageer, kom net thuis van mijn werk
nog snel even mail lezen
dit is idd een heel verschil in code
Ik moet nog veel heel veel leren maar hir op het forum wordt je prima geholpen.
dat VBA heeft mij in de ban
:thumb: