Alleen de ingevulde vleden van een userform wegschrijven

rayda39 · 16 mei 2019

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

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.

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

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

Mvg

VenA · 16 mei 2019

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?

TitaTovenaar · 17 mei 2019

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?

rayda39 · 17 mei 2019

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

VenA · 17 mei 2019

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.

rayda39 · 17 mei 2019

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 :thumb::thumb:

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

rayda39 · 20 mei 2019

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 :thumb:
Nu wilde ik graag de volgende gegevens toevoegen, Code dan in kollom 6 en Opmerkingen in kollom 7.

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

OctaFish · 20 mei 2019

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.

OctaFish · 20 mei 2019

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

rayda39 · 20 mei 2019

Beste Octafish,

Dank u wel voor de code.
Helaas schrijf hij de onderste rij niet weg.

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

VenA · 20 mei 2019

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.

rayda39 · 21 mei 2019

Beste VenA,

Als eerst, ontzettend bedankt :thumb:.
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. :thumb::thumb:

Alleen de ingevulde vleden van een userform wegschrijven

rayda39

Gebruiker

Bijlagen

VenA

Inventaris

TitaTovenaar

Gebruiker

rayda39

Gebruiker

Bijlagen

VenA

Inventaris

rayda39

Gebruiker

rayda39

Gebruiker

Bijlagen

OctaFish

Verenigingslid

OctaFish

Verenigingslid

rayda39

Gebruiker

VenA

Inventaris

Bijlagen

rayda39

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy