• 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.

Textbox tekst naar getal omzetten

Status
Niet open voor verdere reacties.
Aarrgghhh... dat is het! Amerikaanse notatie voor komma is een punt. :o:o:o
 
Hier een voorbeeld om bij een aantal textboxen verplicht een getal in te voeren.
geef tussen "|" (shift + toets boven enter) de getallen van de textboxen aan die numeriek moeten zijn.
tevens wordt , door . vervangen.



Code: 
Private Sub NieuweInvoerOpslaan_Click()
Dim lRow As Long
'Vind de eerste lege rij in uw database
lRow = Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
'copy the data to the database
With Sheets("Blad1")
    .Cells(lRow, 1) = Me.ComboBox1.Value
    For i = 2 To 5
        If InStr("|2|3|4|", "|" & i & "|") Then
            Me("TextBox" & i).Value = Replace(Me("TextBox" & i).Value, ",", ".")
            If Not IsNumeric(Me("TextBox" & i).Value) Then
                MsgBox "Er wordt een numerieke waarde verwacht bij textbox " & i & "."
                Me("TextBox" & i).SetFocus
                Exit Sub
                Exit For
            End If
        End If
        .Cells(lRow, i) = Me("TextBox" & i).Value
    Next
End With
'clear the data
Me.ComboBox1.Value = ""
For i = 2 To 5
Me("TextBox" & i).Text = ""
Next
Me.ComboBox1.SetFocus
End Sub

Niels
 
Niels28 zei:
Hier een voorbeeld om bij een aantal textboxen verplicht een getal in te voeren.
geef tussen "|" (shift + toets boven enter) de getallen van de textboxen aan die numeriek moeten zijn.
tevens wordt , door . vervangen.
Klik om te vergroten...

Betekent dit dat bij het invoeren van nieuwe data of wijzigen van bestaande data gewoon een komma kan worden gebruikt?
 
Ja er kan nu een , ingevuld worden en deze wordt dan door de macro vervangen door een .

PS voor wijzigen van data moet je de macro nog wel hetzelfde maken als voor opslaan.

Niels
 
Laatst bewerkt:
Ik krijg bij het testen nu de melding dat er een numerieke weergave wordt verwacht. Op zich keurig, maar bij een nieuwe invoer worden niet altijd meteen alle velden gevuld. Die worden vaak later toegevoegd.

Kan die melding ook achterwege blijven?
 
zo?

reactie op #25

Code: 
Private Sub WijzigenEnOpslaan_Click()
    With Worksheets("Blad1")
    waarde = Me.ComboBox1.Value
              .Cells(code, 1) = waarde
        For i = 2 To 5
        If InStr("|2|3|4|", "|" & i & "|") Then
            Me("TextBox" & i).Value = Replace(Me("TextBox" & i).Value, ",", ".")
            If Not IsNumeric(Me("TextBox" & i).Value) Then
                MsgBox "Er wordt een numerieke waarde verwacht bij textbox " & i & "."
                Me("TextBox" & i).SetFocus
                Exit Sub
                Exit For
            End If
        End If
        .Cells(code, i) = Me("TextBox" & i).Value
        Next
    End With
End Sub

Niels
 
op #26

Code: 
  If Not IsNumeric(Me("TextBox" & i).Value) And Me("TextBox" & i).Value <> "" Then

Niels
 
Cool! Bovenstaande werkt tot zover. :thumb:

Loop nog tegen wat 'bugs' aan. Als er per ongeluk op 'Opzoeken' wordt geklikt, verschijnt er een foutmelding. Hoe omzeil ik die? :shocked:

Ik loop nog tegen het probleem met de verborgen rijen aan. In één database is de tekst van rij 56 automatisch van kleur. Zwart dus. De rijen 57 en 58 zijn rood en verborgen (er zijn trouwens meerdere rijen rood en verborgen). Rij 58 is de laatste rij. Bij nieuwe invoer wordt rij 57 echter nog overschreven. :confused:

Ik zal mijn code uit de module plaatsen

Code: 
Sub Kaart()
    Medewerkerskaart.Show
End Sub

Function LastUsedRow(Optional wks As Worksheet) As Long
    ' Visible or hidden, filtered or not
    Dim iFilt As Long
    Dim iFind As Long
    
    With IIf(wks Is Nothing, ActiveSheet, wks)
        If WorksheetFunction.CountA(.UsedRange) = 0 Then Exit Function
        If .FilterMode Then iFilt = .AutoFilter.Range.Row + .AutoFilter.Range.Rows.Count - 1
        iFind = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    End With
    LastUsedRow = IIf(iFind > iFilt, iFind, iFilt)
End Function

...en de gehele code uit mijn userform

Code: 
Dim code As Integer

Private Sub ComboBox1_Change()
On Error Resume Next
  code = Worksheets("Gegevens").Range("A:AH").Find(ComboBox1.Value, LookIn:=xlFormulas, Lookat:=xlWhole).Row
End Sub

Private Sub UserForm_Initialize()
With Sheets("Gegevens")
    sq = .Range("A3:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
For lLoop = 1 To UBound(sq)
    For lLoop2 = lLoop To UBound(sq)
        If UCase(sq(lLoop2, 1)) < UCase(sq(lLoop, 1)) Then
            str1 = sq(lLoop, 1)
            str2 = sq(lLoop2, 1)
            sq(lLoop, 1) = str2
            sq(lLoop2, 1) = str1
        End If
    Next lLoop2
Next lLoop
ComboBox1.List = sq
End Sub

Private Sub NieuweInvoerOpslaan_Click()
Dim lRow As Long
'Vind de eerste lege rij in uw database
lRow = Sheets("Gegevens").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
'copy the data to the database
With Sheets("Gegevens")
    .Cells(lRow, 1) = Me.ComboBox1.Value
    For i = 2 To 34
        If InStr("|14|15|17|18|19|20|21|22|23|24|25|26|27|28|29|30|31|32|33|34|", "|" & i & "|") Then
            Me("TextBox" & i).Value = Replace(Me("TextBox" & i).Value, ",", ".")
            If Not IsNumeric(Me("TextBox" & i).Value) And Me("TextBox" & i).Value <> "" Then
                MsgBox "Er wordt een numerieke waarde verwacht bij textbox " & i & "."
                Me("TextBox" & i).SetFocus
                Exit Sub
                Exit For
            End If
        End If
        .Cells(lRow, i) = Me("TextBox" & i).Value
    Next
End With
'clear the data
    Me.ComboBox1.Value = ""
    For i = 2 To 34
        Me("TextBox" & i).Text = ""
    Next
    Me.ComboBox1.SetFocus
End Sub

Private Sub WijzigenEnOpslaan_Click()
    With Worksheets("Gegevens")
    waarde = Me.ComboBox1.Value
              .Cells(code, 1) = waarde
        For i = 2 To 34
        If InStr("|14|15|17|18|19|20|21|22|23|24|25|26|27|28|29|30|31|32|33|34|", "|" & i & "|") Then
            Me("TextBox" & i).Value = Replace(Me("TextBox" & i).Value, ",", ".")
            If Not IsNumeric(Me("TextBox" & i).Value) And Me("TextBox" & i).Value <> "" Then
                MsgBox "Er wordt een numerieke waarde verwacht bij textbox " & i & "."
                Me("TextBox" & i).SetFocus
                Exit Sub
                Exit For
            End If
        End If
        .Cells(code, i) = Me("TextBox" & i).Value
        Next
    End With
'clear the data
    Me.ComboBox1.Value = ""
    For i = 2 To 34
        Me("TextBox" & i).Value = ""
    Next
    Me.ComboBox1.SetFocus
End Sub

Private Sub Opzoeken_Click()
    With Worksheets("Gegevens")
        For i = 2 To 34
            Me("TextBox" & i) = .Cells(code, i)
        Next
    End With
End Sub

Private Sub TextBox7_Change()
TextBox7.Value = Format(TextBox7.Text, "dd-mm-yyyy")
End Sub

Private Sub TextBox10_Change()
TextBox10.Value = Format(TextBox10.Text, "dd-mm-yyyy")
End Sub

Private Sub TextBox11_Change()
TextBox11.Value = Format(TextBox11.Text, "dd-mm-yyyy")
End Sub

Private Sub TextBox12_Change()
TextBox12.Value = Format(TextBox12.Text, "dd-mm-yyyy")
End Sub

Private Sub MedewerkersZichtbaar_Click()
Application.ScreenUpdating = False
Rows.Hidden = False
Range("A1").Select
Application.ScreenUpdating = True
Unload Me
End Sub

Private Sub MedewerkersVerbergen_Click()
Application.ScreenUpdating = False
Dim rij As Integer
For rij = 1 To Range("a65500").End(xlUp).Row
If Cells(rij, 1).Font.Color = vbRed Then
Rows(rij).Hidden = True
End If
Next
Range("A1").Select
Application.ScreenUpdating = True
Unload Me
End Sub

Private Sub GaNaarDezeWeek_Click()
    Application.ScreenUpdating = False
    Columns("A:XFD").Hidden = False
    With Sheets("Gegevens")
        i = WorksheetFunction.Match(CLng(Date), .Rows(2), 0)
        Application.Goto .Cells(1, i), True
    End With
    Range("A1").Select
    Application.ScreenUpdating = True
    Unload Me
End Sub

Private Sub Sorteren_Click()
    Application.ScreenUpdating = False
    ActiveWorkbook.Worksheets("Gegevens").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Gegevens").Sort.SortFields.Add Key:=Range("O3:O500" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Gegevens").Sort.SortFields.Add Key:=Range("A3:A500" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Gegevens").Sort
        .SetRange Range("A3:ACS500")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
    Application.ScreenUpdating = True
    Unload Me
End Sub

Private Sub AllesZichtbaar_Click()
    Application.ScreenUpdating = False
    Columns("A:XFD").Hidden = False
    Range("C3").Select
    ActiveWindow.FreezePanes = True
    SendKeys ("^{HOME}")
    Application.ScreenUpdating = True
    Unload Me
End Sub

Private Sub AlleVeldenLeegmaken_Click()
'clear the data
    Me.ComboBox1.Value = ""
    For i = 2 To 34
        Me("TextBox" & i).Text = ""
    Next
    Me.ComboBox1.SetFocus
End Sub
 
vraag1

Code: 
Private Sub Opzoeken_Click()
If ComboBox1.ListIndex = -1 Then Exit Sub
    With Worksheets("Blad1")
        For i = 2 To 5
            Me("TextBox" & i) = .Cells(code, i)
        Next
    End With
End Sub

vraag2

mijn fout :o , ik heb bij de laatste antwoorden gereageerd met een oude macro ipv met de aangepaste

Code: 
Private Sub NieuweInvoerOpslaan_Click()
Dim lRow As Long
'Vind de eerste lege rij in uw database
lRow = LastUsedRow() 'dit is aangepast
'copy the data to the database
With Sheets("Gegevens")
enz.....


Niels
 
Probleempje 'Opzoeken' is opgelost. :thumb:

Verborgen rijen wordt nu niet rij 57, maar rij 58 overschreven, terwijl de nieuwe invoer in 59 zou moeten komen.
 
Ik heb vandaag geen tijd meer, kom er morgen op terug.

Niels
 
Meteen nog een vraagje:

Is het mogelijk om na een nieuwe invoer de data meteen te sorteren? Eerst op kolom O en daarna op kolom A?

Wheel
 
Zo zou het moeten lukken, bereik aanpassen waar het aangegeven is aan jouw kolommen

Code: 
Private Sub NieuweInvoerOpslaan_Click()
Dim lRow As Long
'Vind de eerste lege rij in uw database
[COLOR="#FF0000"]lRow = LastUsedRow() +1[/COLOR]
'copy the data to the database
With Sheets("Gegevens")
enz.....

    With ActiveWorkbook.Worksheets("Blad1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("O2:O" & lrow - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("A2:A" & lrow - 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A2:O" & lrow - 1) 'deze aanpassen aan jouw bereik
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Niels
 
Hoi Niels,

Sorteren en invoeren werkt nu wel :thumb:

Echter, bij de nieuw ingevoerde rijen wordt op willekeurige plaatsen data overgenomen uit andere rijen. Dus opeens zijn bijvoorbeeld kolom P, Q, R, S gevuld en ook op andere plaatsen 'verderop' in de database (bijv.kolom LY, LZ) is ook dat 'overgenomen', terwijl ik bij de nieuwe invoer alleen kolom A,B en O heb ingevuld. :confused:

Deze code heb ik aangepast naar A2:O500 of moet ik die tot einde document doen? In dit geval tot kolom ACI?

Code: 
.SetRange Range("A2:O" & lrow - 1) 'deze aanpassen aan jouw bereik
 
Ik heb de code geprobeerd tot ACI en het lijkt erop dat het nu wel goed werkt.

Wat gebeurt er dan als ik 'maar' tot O codeer? Even voor mijn leermomentje... :o
 
Hmm.. de sortering loopt toch niet helemaal lekker.

Als de rijen allemaal zichtbaar zijn, wordt perfect gesorteerd. Als er rijen zijn verborgen, wordt de sortering wat door elkaar gegooid op kolom O en ook op A. :confused:
 
Laatst bewerkt:
Ik blijf je lastig vallen :D

In kolom AG (TextBox33 in het UserForm) staan gegevens die uit een andere werkmap worden opgehaald door middel van een formule.

Als er bij deze medewerker een wijziging heeft plaatsgevonden in het Userform en de wijziging wordt opgeslagen, dan is de formule verdwenen. :(

Ook de voorwaardelijke opmaak is weg.
 
Laatst bewerkt:
In de TextBoxen waarin een datum moet worden weergegeven, kan ik bij het invoeren echter geen datum invullen. :confused:

Ik heb de TextBoxen op de volgende wijze gedefinieerd om de weergave (bijv. 01-01-2012) bij het opvragen van de gegevens.

Code: 
Private Sub TextBox7_Change()
TextBox7.Value = Format(TextBox7.Text, "dd-mm-yyyy")
End Sub
 
Sorteren moet je tot de laatste kolom invulle dus AC , anders worden deze kolommen niet mee gesorteerd en staat je data door elkaar.
Sorteren blijft volgens mij een probleem met verborgen kolommen.

Datum wegschrijven vanuit een textbox

Code: 
cells(lrow,"??").value=Cdate(TextBox7.value)

Je moet echt stoppen met .text achter een textbox te zetten dit werkt beter met .value
met .text maak je overal text van.

Formules raakt je kwijt als je er een textbox waarde in weg schrijft textbox33 wil je dus niet weg schrijven in de cel en die moet je dus overslaan in je macro.
Als er iets moet veranderen aan de gegevens zou je dit in het bron bestand aan moeten passen.

Niels
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan