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

Gegevens in menu in vullen, dan in excel zetten

Status
Niet open voor verdere reacties.

MarnixE

Gebruiker
Lid geworden
17 sep 2012
Berichten
32
Hallo,

Ik heb een Statistieken bestand voor een voetbalclub, hierin houdt ik onder meer presentie, doelpunten, speelminuten bij (dit bestand is alleen te groot om up te loaden:confused:)..
Nou voer ik momenteel alles na de wedstrijd met hand in, best veel werk.. Nou heb ik bij iemand een bestand gezien waarin diegene nadat hij op open menu klikt veel dingen in kan vullen en deze in excel verschijnen. Zoiets zou ook perfect zijn voor mijn bestand. Nou heb ik een klein begin, zie de bijlage. Zodra er op de open menu knop gedrukt wordt en daarna op Speelminuten opent een venster zich met de spelers en daarachter een tekstvak waar de speelminuten ingevuld kunnen worden. Nou wil ik dat zodra ik achter iedere speler wat invul en daarna op invoegen klik, dat alle gegevens onder elkaar ergens verschijnen. Maar wat voor codes heb ik hiervoor nodig?


Bekijk bijlage Sjabloon beginverwerking.xls
 
Die basiscode staat toch al in het Userform, je moet enkel de nodige aanpassingen doen betreffende werkbladnaam ??
En hoe is je werkblad met spelersnamen opgebouwd ?
 
Hallo Warm Bakkertje,


Mijn bladen, heb even speelminuten weer als voorbeeld genomen, zien er als volgt uit; Excel.jpg
Dus op het moment dat ik het voor competitie invul moet hij iedere volgende wedstrijd een verder naar rechts ingevuld worden voor iedere speler.
En de formules voor het neerzetten in excel staan nog niet in de userform toch?
 
Aan een jpg'tje hebben wij niks, het is zelfs niet duidelijk te lezen waar en wat.
Zoals ik al zei de BASIScode is al aanwezig.
Code:
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Uren")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(1, 0).Row

'copy the data to the database
ws.Cells(iRow, 1).Value = Me.TextBox1.Value
ws.Cells(iRow, 2).Value = Me.TextBox2.Value
ws.Cells(iRow, 3).Value = Me.TextBox3.Value
ws.Cells(iRow, 5).Value = Me.TextBox4.Value
ws.Cells(iRow, 6).Value = Me.TextBox5.Value
ws.Cells(iRow, 7).Value = Me.TextBox6.Value
ws.Cells(iRow, 8).Value = Me.TextBox7.Value
Unload Me
Worksheets("Uren").Select
End Sub
 
Ik heb alles volledig aangepast zoals het op het werkblad staat.
 

Bijlagen

Super bedankt, Warme Bakkertje!
Hiermee gaat het zeker lukken, dank je!
 
Warme Bakkertje?
Zou u misschien nog één keer kunnen helpen?
Nadat ik het uiterlijk had aangepast en alle knoppen aan het juiste doel gekoppeld had, wou ik verder gaan met de code die u mij gegeven heeft.
Want zoals nu te zien valt Bekijk bijlage speelminy.xlsx is als je vanaf het menu naar invoer--> competitie gaat dat daar nu naast speelminuten, zeg maar alle in te voeren waarden staan.
Omdat ik uw code niet helemaal begrijp, vraag ik mij af hoe krijg ik nu bijvoorbeeld Assists (die nu ook in het bestand zit) op het moment dat ik ze invul en op INVOEGEN klik dat er het zelfde gebeurd als wat er nu al met de speelminuten gebeurd?
Zou u mij dit alstublieft voor kunnen doen?? Dan hoop ik het daarna met de andere waarden zelf te kunnen..
Alvast bedankt,

Marnix
 
Oh en trouwens Warme Bakkertje,

Eigenlijk alleen de Invoer--> Competitie knop werkt nu, deze heb ik uit het normale bestand gehaald want deze is 5 mb en de max hier is 100 kb. Daarom heb ik dus deze selectie er uit gehaald. Dus vandaar dat de codes er wel staan maar in dit bestand geen invloed hebben
 
En waar is het Userform waarvoor die nieuwe code gemaakt moet worden ?
 
Sorry warme bakkertje, was ze vergeten er bij te doen. Heb het nu even op deze manier gedaan omdat met ook het speelminuten blad er bij dan was hij meer dan 100 kb...
Bekijk bijlage speelminy (1).xlsm Dus als je de userforms uit dit bestand in die andere wil zetten dan heb je al het benodigde materiaal volgens mij..
 
Je zal toch eerst moeten zorgen dat al je Textboxen netjes gestructureerd op je invulformulier staan dwz kolom1 TB1 tem TB28, kolom2 TB29 tem TB56 enz...
Dan kan je met betrekkelijk eenvoudige loops alles in 1 keer wegschrijven naar de betreffende werkbladen, want zoals ze nu door elkaar staan gaat het zeker niet lukken.
 
Laatst bewerkt:
Warme Bakkertje,

Ik zal morgen ochtend even alle textboxen goed nummeren... Heeft u een voorbeeld van zo'n loop dan bijvoorbeeld van 1t/m28 in ''Speelminuten'' en 29t/m57 op de zelfde plek en alles maar dan op het blad ''Assists overzicht'' dat ik dat dan zelf invul? Of moet ik hem morgen ochtend gewoon weer even hier op zetten dat u het doet?
Nog een ding, ik weet niet u of u het weet (gezien uw kennis, vast wel) bijvoorbeeld de InvulCompetitie userform is heel hoog en voor mn laptop beeldscherm is hij te groot, voor mn externe beeldscherm niet, maar weet u misschien of hier een scroll functie in te krijgen is, zodat hij gewoon normale afmetingen heeft en dat je dan naar beneden scrollt?
Alvast bedankt

Marnix
 
Laatst bewerkt:
Is het dan de bedoeling dat je dit nieuwe formulier in 1 keer volledig invult en dan wegschrijft, of dat je de ene keer de speelminuten invult en wegschrijft en op een later tijdstip een ander criteria?
 
Dan heb je in mijn eerdere bestand toch al een voorbeeld van een loop staan?
Je moet dan enkel de bladnaam aanpassen en eventueel het bereik waarheen geschreven moet worden.
De enige aanpassing die eventueel nog gemaakt kan worden is dat wanneer geen waarde ingevuld wordt er toch een 0 weggeschreven wordt, dit om fouten te vermijden.
 
Klopt het voorbeeld is er, zou je dan alleen nog even kort de loop toe kunnen lichten, zodat ik precies weet waar alles in te vullen. Die 0 invullen hoe doe ik die aanpassing in de loop? En dan nog even wat ik eerder schreef: "Nog een ding, ik weet niet u of u het weet (gezien uw kennis, vast wel) bijvoorbeeld de InvulCompetitie userform is heel hoog en voor mn laptop beeldscherm is hij te groot, voor mn externe beeldscherm niet, maar weet u misschien of hier een scroll functie in te krijgen is, zodat hij gewoon normale afmetingen heeft en dat je dan naar beneden scrollt?"
 
Voeg een standaardmodule in en ga dan als volgt tewerk
Code:
Sub Speelminuten()
Dim iCol As Long, data(28)
With Worksheets("Speelminuten")
    'find first empty column in database
    iCol = IIf(.Cells(6, 23) = "", 23, .Cells(6, 50).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(6, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Sub Assists()
Dim iCol As Long, data(28)
With Worksheets("Assists Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub
Maak nu voor elk werkblad een nieuwe sub aan.
De Macro's in je formulier Invulcompetitie gaan er dan zo uitzien
Code:
Private Sub CommandButton1_Click()
    Speelminuten
    Assists
    Unload Me
End Sub

Private Sub CommandButton2_Click()
    Unload Me
    Menu.Show
End Sub

Private Sub CommandButton3_Click()
    Speelminuten
    Assists
    Unload Me
    UserForm1.Show
End Sub
 
Warme Bakkertje,

Ik heb nu alles ingevoerd in een module: Sub Speelminuten()
Code:
Dim iCol As Long, data(28)
With Worksheets("Speelminuten")
    'find first empty column in database
    iCol = IIf(.Cells(6, 23) = "", 23, .Cells(6, 50).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(6, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Code:
Sub Presentie()
Dim iCol As Long, data(28)
With Worksheets("Presentielijst Wedstrijden")
    'find first empty column in database
    iCol = IIf(.Cells(6, 23) = "", 23, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub
Code:
Sub Geel()
Dim iCol As Long, data(28)
With Worksheets("Gele Kaarten")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(6, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Code:
Sub Rood()
Dim iCol As Long, data(28)
With Worksheets("Rode Kaarten")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

Code:
Sub Kaarten()
Dim iCol As Long, data(28)
With Worksheets("Kaarten Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(6, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub
Code:
Sub Assists()
Dim iCol As Long, data(28)
With Worksheets("Assists Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub
Code:
Sub Doelpunten()
Dim iCol As Long, data(28)
With Worksheets("Doelpunten Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(10, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(Me("Textbox" & i + 1).Value = "", 0, Me("Textbox" & i + 1).Value)
    Next
    'copy the data to the database
    .Cells(10, iCol).Resize(28) = WorksheetFunction.Transpose(data)
    Application.Goto .Cells(1), True
End With
End Sub

en dan in het UserForm:
Code:
Private Sub CommandButton1_Click()
    Speelminuten
    Presentie
    Geel
    Rood
    Kaarten
    Assists
    Doelpunten
    Unload Me
End Sub

Code:
Private Sub CommandButton2_Click()
    Unload Me
    Menu.Show
End Sub

Code:
Private Sub CommandButton3_Click()
    Speelminuten
    Presentie
    Geel
    Rood
    Kaarten
    Assists
    Doelpunten
    Unload Me
    InvulCompetitie.Show
End Sub

Maar als ik nu wat invoer zegt hij:

Compileerfout:

Ongeldig gebruik van het sleutelwoord Me

Wat is er fout? Waar ligt het aan? kan er zelf weinig verkeerds in vinden...
 
Laatst bewerkt door een moderator:
Vervang in al de macro's het woord Me door InvulCompetitie
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan