• 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.
Ik zal wel ongelofelijk dom zijn, Warme Bakkertje.
Maar heb een avondje lopen *****n heb in de standaardmodule:
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(32, 50).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulCompetitie("Textbox" & i + 1).Value = "", 0, InvulCompetitie("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(32, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulCompetitie("Textbox" & i + 1).Value = "", 0, InvulCompetitie("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 Geel()
Dim iCol As Long, data(28)
With Worksheets("Gele Kaarten")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(32, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulCompetitie("Textbox" & i + 1).Value = "", 0, InvulCompetitie("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 Rood()
Dim iCol As Long, data(28)
With Worksheets("Rode Kaarten")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(32, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulCompetitie("Textbox" & i + 1).Value = "", 0, InvulCompetitie("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(32, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulCompetitie("Textbox" & i + 1).Value = "", 0, InvulCompetitie("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 Assists()
Dim iCol As Long, data(28)
With Worksheets("Assists Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 27) = "", 27, .Cells(32, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulCompetitie("Textbox" & i + 1).Value = "", 0, InvulCompetitie("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(32, 48).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulCompetitie("Textbox" & i + 1).Value = "", 0, InvulCompetitie("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 SpeelminutenBeker()
Dim iCol As Long, data(28)
With Worksheets("Speelminuten")
    'find first empty column in database
    iCol = IIf(.Cells(6, 33) = "", 23, .Cells(5, 14).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulBeker("Textbox" & i + 1).Value = "", 0, InvulBeker("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 PresentieBeker()
Dim iCol As Long, data(28)
With Worksheets("Presentielijst Wedstrijden")
    'find first empty column in database
    iCol = IIf(.Cells(6, 33) = "", 23, .Cells(5, 14).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulBeker("Textbox" & i + 1).Value = "", 0, InvulBeker("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 GeelBeker()
Dim iCol As Long, data(28)
With Worksheets("Gele Kaarten")
    'find first empty column in database
    iCol = IIf(.Cells(10, 37) = "", 27, .Cells(5, 14).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulBeker("Textbox" & i + 1).Value = "", 0, InvulBeker("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 RoodBeker()
Dim iCol As Long, data(28)
With Worksheets("Rode Kaarten")
    'find first empty column in database
    iCol = IIf(.Cells(10, 37) = "", 27, .Cells(5, 14).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulBeker("Textbox" & i + 1).Value = "", 0, InvulBeker("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 KaartenBeker()
Dim iCol As Long, data(28)
With Worksheets("Kaarten Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 37) = "", 27, .Cells(5, 14).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulBeker("Textbox" & i + 1).Value = "", 0, InvulBeker("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 AssistsBeker()
Dim iCol As Long, data(28)
With Worksheets("Assists Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 37) = "", 27, .Cells(5, 14).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulBeker("Textbox" & i + 1).Value = "", 0, InvulBeker("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 DoelpuntenBeker()
Dim iCol As Long, data(28)
With Worksheets("Doelpunten Overzicht")
    'find first empty column in database
    iCol = IIf(.Cells(10, 37) = "", 27, .Cells(5, 14).End(xlToLeft).Offset(, 1).Column)
    'fill array with Textboxvalues
    For i = 0 To 27
        data(i) = IIf(InvulBeker("Textbox" & i + 1).Value = "", 0, InvulBeker("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



Dus ook alles voor de invoer van Beker Wedstrijden erbij, maar wat hij ook bij de competitie invoer doet, als ik in textbox 1 (hoort bij Speelminuten) een 1 invul dan vult hij deze voor alle criteria in (dus ook bij doelpunten, assists ed.) dit is een beetje vaag dus. Daarnaast wil de beker invoer niet in de juiste kolom terecht komen.. Doe ik zo iets ergs fout? De Competitie moet tussen de 23 en 49, de beker tussen 5 en 14, nacompetitie 60t/m 68 en oefen 72 t/m 84.
Zou u mij hier nog bij kunnen helpen?
En misschien nog antwoord kunnen geven op de scroll vraag?
Alvast super bedankt,

Marnix
 
Laatst bewerkt door een moderator:
Je moet uiteraard ook onderstaande aanpassen om de juiste TB weg te schrijven
Code: 
data(i) = IIf(InvulCompetitie("Textbox" & i + 1).Value = "", 0, InvulCompetitie("Textbox" & i + 1).Value)
Voor Presentie wordt de +1 dan +29 , voor Gele kaarten +57 , Rode kaarten +85 enz....

We zullen zien dat we dit eerst allemaal werkend krijgen alvorens verder te gaan met de ScreenSize, denk je dat ook niet ?
 
Warme Bakkertje,
Hoe kan ik u even het hele bestand sturen waar ik alles in heb staan, zodat u alles eens even kan bekijken? Want volgens mij heb ik nu alle formules goed staan, maar het invullen gaat nog niet goed:O
Dus misschien is het handig dat u het hele bestand eens bekijkt...
 
@MarnixE Code dient tussen de codetags te staan, let hier de volgende keer op. Berichten aangepast.
 
Laatst bewerkt:
Al eens geprobeerd het bestand in te pakken met Winzip of Winrar ?
Stuur mij anders via deze site een bericht zodat ik je kan antwoorden.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan