Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 12 van 12

Onderwerp: Alleen de ingevulde vleden van een userform wegschrijven

  1. #1
    Member
    Donateur

    Geregistreerd
    20 maart 2009
    Vraag is opgelost

    Alleen de ingevulde vleden van een userform wegschrijven

    Beste Leden,

    Ik zal proberen zo goed mogelijk uitleggen waar ik tegen aan loop en graag zou willen.
    Als eerst wil ik graag zeggen dat ik geen specialist ben en veel knip en plak werk gebruik en soms ook zelf iets verzin.

    Ik heb de volgende file gemaakt Urenstaat in Excel 2019 Versie 1.20 (Office 2007-2016) 3446.xlsm (toegevoegd als bijlage) op het tabblad Uren 3446 staat een knop "Button 1" deze opent een userform. Voor het forum heb ik hem iets aangepast, normaal moet je van boven naar onder alles invullen en dan pas worden de volgende velden zichtbaar.

    Voor het wegschrijven van de ingevulde gegevens gebruik ik de volgende code.

    Code:
    Private Sub Cmbverwerken_Click()
    
     With ActiveSheet
                   
            Dim iRow As Long
            Dim ws As Worksheet
            Set ws = Worksheets("Uren 3446")
                                    
            iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            
            ws.Cells(iRow, 1).Value = Me.DTPicker1.Value
            ws.Cells(iRow, 2).Value = Me.ComboBox1.Value
            ws.Cells(iRow, 3).Value = Me.ComboBox2.Value
            ws.Cells(iRow, 4).Value = Me.TextBox1.Value
            ws.Cells(iRow, 5).Value = Me.TextBox7.Value
      
            iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            
            ws.Cells(iRow, 1).Value = Me.DTPicker1.Value
            ws.Cells(iRow, 2).Value = Me.ComboBox1.Value
            ws.Cells(iRow, 3).Value = Me.ComboBox3.Value
            ws.Cells(iRow, 4).Value = Me.TextBox2.Value
            ws.Cells(iRow, 5).Value = Me.TextBox8.Value
                                            
            iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            
            ws.Cells(iRow, 1).Value = Me.DTPicker1.Value
            ws.Cells(iRow, 2).Value = Me.ComboBox1.Value
            ws.Cells(iRow, 3).Value = Me.ComboBox4.Value
            ws.Cells(iRow, 4).Value = Me.TextBox3.Value
            ws.Cells(iRow, 5).Value = Me.TextBox9.Value
                                        
            iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            
            ws.Cells(iRow, 1).Value = Me.DTPicker1.Value
            ws.Cells(iRow, 2).Value = Me.ComboBox1.Value
            ws.Cells(iRow, 3).Value = Me.ComboBox5.Value
            ws.Cells(iRow, 4).Value = Me.TextBox4.Value
            ws.Cells(iRow, 5).Value = Me.TextBox10.Value
            
            iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            
            ws.Cells(iRow, 1).Value = Me.DTPicker1.Value
            ws.Cells(iRow, 2).Value = Me.ComboBox1.Value
            ws.Cells(iRow, 3).Value = Me.ComboBox6.Value
            ws.Cells(iRow, 4).Value = Me.TextBox5.Value
        End With
               
      DTPicker1.Value = (Now)
      ComboBox1.ListIndex = 0
      ComboBox2.ListIndex = -1
      ComboBox3.ListIndex = -1
      ComboBox4.ListIndex = -1
      ComboBox5.ListIndex = -1
      ComboBox6.ListIndex = -1
      TextBox1.Value = ""
      TextBox2.Value = ""
      TextBox3.Value = ""
      TextBox4.Value = ""
      TextBox5.Value = ""
      TextBox6.Value = ""
      TextBox7.Value = ""
      TextBox8.Value = ""
      TextBox9.Value = ""
      TextBox10.Value = ""
      'ActiveWorkbook.Save
    End Sub
    Deze schrijft alle invulvelden weg ook al staat er niets in.
    Dit kun je zien als voorbeeld op Tabblad 2
    Klik op afbeelding voor grotere versie

Naam:  Capture.PNG
Bekeken: 17
Grootte:  21,0 KB

    Nu zou ik graag dat alleen de rij die ingevuld is ook weggeschreven word (met de datum en naam)
    Onderstaand heb ik een screenschot gemaakt van wat ik bedoel
    Als rij 1 is ingevuld dan alleen rij 1.
    Als rij 1 en 5 is ingevuld dan rij 1 en 5.

    Klik op afbeelding voor grotere versie

Naam:  Capture.PNG
Bekeken: 14
Grootte:  41,1 KB

    Met Rij 1 bedoel ik dan Combobox2, TextBox1 en Textbox7 .

    Hopelijk kan iemand mij helpen of de juiste richting in sturen.

    Mvg
    Bijgevoegde bestanden Bijgevoegde bestanden

  2. #2
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Ik zou eerst die DTPicker1 eruit halen. Deze werkt niet meer in nieuwe versies van Excel. Het controleren op de uren is nogal bijzonder.
    normaal moet je van boven naar onder alles invullen en dan pas worden de volgende velden zichtbaar.
    Waarom zit het niet in het voorbeeld dan?
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  3. #3
    Member
    Geregistreerd
    7 februari 2018
    Locatie
    Krommenie
    Afstand tot server
    ±123 km
    Het zou voor de verwerking van code een stuk simpeler zijn indien de nummering van je textboxen logischer zou zijn. Nu is voor de eerste 1 en 7 een textbox, waarom is dat niet gewoon 1 en 2?

  4. #4
    Member
    Donateur

    Geregistreerd
    20 maart 2009
    Beste VenA,

    Ik heb de voledige file bijgevoegd, soms lees ik wel op het forum dat leden het niet fijn vinden als ze eerst door vanalles heen moeten klikken, ik had dat bij de vorige om die reden weggehaald.

    Zou u me kunnen uitleggen welke ik in de plaats van DTPicker1 zou moeten gebruiken?

    Ik gebruik nu excel 2013 en heb ook op het net gekeken wat mensen gebruiken in excel 2016, ze adviseren mscomct2.ocx te downloaden en te instaleren, dit had ik ook al gedaan voordat ik deze userforum maakte.
    Mischien kunt u me in de richting sturen wat ik dan zou moeten gebruiken?

    U geeft aan "Het controleren op de uren is nogal bijzonder" indien u bedoelt de manier waarop (in de vba code)dan kan ik alleen maar zeggen dat het waarschijnlijk een gebrek aan kennis is en deze manier werkt ook ( waarschijnlijk niet de beste manier ) maar ik sta open voor ideeen.



    Beste TitaTovenaar.
    Daar kan ik je helemaal gelijk in geven, is gewoon zo gegroeit en zal ik gaan aanpassen.

    Mvg
    Bijgevoegde bestanden Bijgevoegde bestanden

  5. #5
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Het kan allemaal wel een beetje eenvoudiger.

    Code:
    Private Sub Cmbverwerken_Click()
      Dim t As Long, j As Long
      ReDim ar(1 To 5, 1 To 5)
      t = 1
      For j = 1 To 5
        If Me("TextBox" & j) <> "" Then
          ar(t, 1) = DTPicker1
          ar(t, 2) = ComboBox1
          ar(t, 3) = Me("ComboBox" & j + 1)
          ar(t, 4) = Me("TextBox" & j).Value
          If j < 5 Then ar(t, 5) = Me("TextBox" & j + 6).Value
          t = t + 1
        End If
      Next j
      Sheets("Uren 3446").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(t - 1, 5) = ar
      For Each ct In Me.Controls
        If TypeName(ct) = "TextBox" Then ct.Value = ""
        If TypeName(ct) = "ComboBox" Then ct.ListIndex = IIf(ct.Name = "ComboBox1", 0, -1)
        ct.Visible = False
      Next ct
      DTPicker1.Visible = True
      DTPicker1.Value = (Now)
    End Sub
    Code:
    Private Sub Controlen_Click()
      If Werkuren.Caption = TextBox6.Value Then Cmbverwerken.Visible = True Else MsgBox "Ingevulde uren komen niet overeen met contract uren"
    End Sub
    Waarbij het raar is dat er geen overuren gemaakt kunnen worden.
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  6. #6
    Member
    Donateur

    Geregistreerd
    20 maart 2009
    Beste VenA,

    U heeft zowieso mijn probleem opgelost, daarvoor alvast bedankt.
    Zo ziet u dat mijn kennis en kunde nogal laag is.

    De eerste Code die u geeft ga ik me eens in verdiepen, ik begrijp hem gedeeltelijk en ziet er inderdaad een heel stuk korter uit.
    De 2de code begrijp ik gelukkig helemaal.

    Alvast enorm bedankt

    O ja, op ons bedrijf worden eigenlijk zeer weinig overuren gemaakt en als die gemaakt worden dan worden ze gewoon opschreven en b.v. de volgende werkdag opgenomen.
    Maar ik ga eens kijken hoe ik deze alsnog erbij krijg.

    Mvg
    Laatst aangepast door rayda39 : 17 mei 2019 om 10:59

  7. #7
    Member
    Donateur

    Geregistreerd
    20 maart 2009
    Beste Helpmij leden,

    Graag zou ik toch nog eens een verzoek aan jullie willen doen die direct met deze vraag te maken heeft.
    Mijn initiele vraag vraag was opgelost door VenA.

    Nu wilde ik graag nog 2 kollom erbij hebben en ik dacht dat lukt mij wel, helaas .

    Van Vena had ik de volgende Code gekregen.

    Code:
    Private Sub Cmbverwerken_Click()
      Dim t As Long, j As Long
      ReDim ar(1 To 5, 1 To 5)
      t = 1
      For j = 1 To 5
        If Me("TextBox" & j) <> "" Then
          ar(t, 1) = DTPicker1
          ar(t, 2) = ComboBox1
          ar(t, 3) = Me("ComboBox" & j + 1)
          ar(t, 4) = Me("TextBox" & j).Value
          If j < 5 Then ar(t, 5) = Me("TextBox" & j + 6).Value
          t = t + 1
        End If
      Next j
      Sheets("Uren 3446").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(t - 1, 5) = ar
      For Each ct In Me.Controls
        If TypeName(ct) = "TextBox" Then ct.Value = ""
        If TypeName(ct) = "ComboBox" Then ct.ListIndex = IIf(ct.Name = "ComboBox1", 0, -1)
        ct.Visible = False
      Next ct
      DTPicker1.Visible = True
      DTPicker1.Value = (Now)
    End Sub
    Deze werkt prima
    Nu wilde ik graag de volgende gegevens toevoegen, Code dan in kollom 6 en Opmerkingen in kollom 7.

    Klik op afbeelding voor grotere versie

Naam:  Capture.PNG
Bekeken: 6
Grootte:  23,5 KB

    Hierbij had ik de volgende code aangepast.

    Code:
    rivate Sub Cmbverwerken_Click()
    Dim t As Long, j As Long
      ReDim ar(1 To 7, 1 To 7)
      t = 1
      For j = 1 To 18
        If Me("TextBox" & j) <> "" Then
          ar(t, 1) = DTPicker1
          ar(t, 2) = ComboBox1
          ar(t, 3) = Me("ComboBox" & j + 1)
          ar(t, 4) = Me("TextBox" & j).Value
          If j < 5 Then ar(t, 5) = Me("TextBox" & j + 6).Value
          If j < 14 Then ar(t, 6) = Me("TextBox" & j + 11).Value
          If j < 18 Then ar(t, 7) = Me("TextBox" & j + 15).Value
          t = t + 1
        End If
      Next j
      Sheets("Uren 3446").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(t - 1, 7) = ar
      For Each ct In Me.Controls
        If TypeName(ct) = "TextBox" Then ct.Value = ""
        If TypeName(ct) = "ComboBox" Then ct.ListIndex = IIf(ct.Name = "ComboBox1", 0, -1)
        ct.Visible = False
      Next ct
      DTPicker1.Visible = True
      DTPicker1.Value = (Now)
    End Sub
    Nu is het zo dat hij me vast loopt op het volgende stuk

    Code:
    ar(t, 3) = Me("ComboBox" & j + 1)
    Zou ik nogmaals jullie support kunnen krijgen en/of kunnen uitleggen hoe ik de code kan aanpassen zodat deze wel werkt

    ik heb het bestand dat vastloopt erbij gevoegd.

    Mvg
    Bijgevoegde bestanden Bijgevoegde bestanden

  8. #8
    Tera Honourable Senior Member
    Verenigingslid
    OctaFish's avatar
    Geregistreerd
    6 februari 2009
    Locatie
    Rotterdam
    Afstand tot server
    ±151 km
    Je hebt 6 comboboxen; je code zoekt (dankzij Me("ComboBox" & j + 1)) naar comboboxen die zijn genummerd van ComboBox2 naar ComboBox19. Je mist dus 13 comboboxen om uit te lezen.
    Gebruik de QUOTE knop alleen als je iets wit citeren.
    Op deze pagina kun je zien hoe je met TAGS werkt.

  9. #9
    Tera Honourable Senior Member
    Verenigingslid
    OctaFish's avatar
    Geregistreerd
    6 februari 2009
    Locatie
    Rotterdam
    Afstand tot server
    ±151 km
    En dan kun je het zo oplossen:
    Code:
        For j = 2 To 5
            If Me("ComboBox" & j) <> "" Then
                ar(t, 1) = DTPicker1
                ar(t, 2) = Me.ComboBox1
                ar(t, 3) = Me("ComboBox" & j)
                ar(t, 4) = Me("TextBox" & j - 1).Value
                ar(t, 5) = Me("TextBox" & j + 5).Value
                ar(t, 6) = Me("TextBox" & j + 9).Value
                ar(t, 7) = Me("TextBox" & j + 13).Value
            End If
            t = t + 1
        Next j
    Gebruik de QUOTE knop alleen als je iets wit citeren.
    Op deze pagina kun je zien hoe je met TAGS werkt.

  10. #10
    Member
    Donateur

    Geregistreerd
    20 maart 2009
    Beste Octafish,

    Dank u wel voor de code.
    Helaas schrijf hij de onderste rij niet weg.
    Klik op afbeelding voor grotere versie

Naam:  Capture.PNG
Bekeken: 8
Grootte:  22,2 KB

    De volledige code is nu :

    Code:
    Private Sub Cmbverwerken_Click()
    Dim t As Long, j As Long
      ReDim ar(1 To 7, 1 To 7)
      t = 1
          For j = 2 To 5
            If Me("ComboBox" & j) <> "" Then
                ar(t, 1) = DTPicker1
                ar(t, 2) = Me.ComboBox1
                ar(t, 3) = Me("ComboBox" & j)
                ar(t, 4) = Me("TextBox" & j - 1).Value
                ar(t, 5) = Me("TextBox" & j + 5).Value
                ar(t, 6) = Me("TextBox" & j + 9).Value
                ar(t, 7) = Me("TextBox" & j + 13).Value
            End If
            t = t + 1
        Next j
      Sheets("Uren 3446").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(t - 1, 7) = ar
      For Each ct In Me.Controls
        If TypeName(ct) = "TextBox" Then ct.Value = ""
        If TypeName(ct) = "ComboBox" Then ct.ListIndex = IIf(ct.Name = "ComboBox1", 0, -1)
        ct.Visible = False
      Next ct
      DTPicker1.Visible = True
      DTPicker1.Value = (Now)
    End Sub
    Ik heb een vermoeden dat het komt omdat de onderste combobox "combobox6" is.
    Kan u me nog op weg helpen

    Mvg
    Laatst aangepast door rayda39 : 20 mei 2019 om 14:43

  11. #11
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Waarom ga je verder met een oud bestand? De eerder gemaakte optimalisatie zit hier niet in! Alles is een kwestie van logisch nadenken en tellen. Zonder de datepicker maar met een kalender formulier.
    Bijgevoegde bestanden Bijgevoegde bestanden
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  12. #12
    Member
    Donateur

    Geregistreerd
    20 maart 2009
    Beste VenA,

    Als eerst, ontzettend bedankt .
    Mijn logisch nadenken is helaas niet zo logisch.
    Ik ben bang dat mijn kennis en logica niet op het juiste niveau is.

    Toch bedankt hiervoor.

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren