opstelling schema rugby

Status
Niet open voor verdere reacties.
E

enrico2312

Gebruiker
Lid geworden
2 mrt 2021
Berichten
7
goedemorgen allen,

Ben bezig om voor onze club een opstelling form te maken alleen ik krijg een 1004 foutmelding.
heb van alles al geprobeerd alleen ik zie het niet meer.

in het groen gaat goed tot het rode dan krijg ik ***fout 1004 tijdens uitvoering door de toepassing of door object gedefinieerde fout***

Code: 
[HR][/HR]
[COLOR="#00FF00"]Option Explicit

    '//////////// Userform Benji's \\\\\\\\\\\\\\\\
    
    
Private Sub CommandButton1_Click()

   '-----------MsgBox----------
    Dim i As VbMsgBoxResult
    
    i = MsgBox("Wil je de opstelling opslaan?", vbYesNo + vbQuestion, "Opslaan")
       
    If i = vbNo Then Unload Me
     
    
  
     
          

    
    Dim sh As Worksheet
    
    Dim irow As Long
    
   
     
  
    
    '-----------------Rood--------------------
    

   If cbTeam.Value = "Rood" Then                                        'Tabblad Benjamnins Rood
    
    
    Set sh = ThisWorkbook.Sheets("Benjamins Rood")                      'Tabblad Benjamnins Rood
     
        
     Application.ScreenUpdating = False
    
    With USFBENJAMINS                                                   'Userform Benji's
    
         
        sh.Range("H4").Value = .cbTYPE.Value                            'Evenment info
        sh.Range("J4").Value = .TBDATUM.Value                           'Evenment info
        sh.Range("H5").Value = .TBLOCATIE.Value                         'Evenment info
        sh.Range("J5").Value = .cbTeam.Value                            'Evenment info
        
        sh.Range("F11").Value = .CBpl1.Value                            'Scrum prop
        sh.Range("G11").Value = .CBpl2.Value                            'Scrum hooker
        sh.Range("H11").Value = .CBpl3.Value                            'Scrum prop
        
        sh.Range("G14").Value = .CBpl4.Value                            'Speler 4
        sh.Range("E15").Value = .CBpl5.Value                            'Speler 5
        sh.Range("I15").Value = .CBpl6.Value                            'Speler 6
        sh.Range("D17").Value = .CBpl7.Value                            'Speler 7
        sh.Range("J17").Value = .CBpl8.Value                            'Speler 8
        
        sh.Range("E20").Value = .CBCaptain.Value                        'Captain
        sh.Range("E21").Value = .CBCoCaptain.Value                      'Co-Captain
        sh.Range("E22").Value = .CBscrumhalf.Value                      'Scrumhalf
        
        sh.Range("G21").Value = .CBws1.Value                            'reserve 1
        sh.Range("G22").Value = .CBws2.Value                            'reserve 2
        sh.Range("G23").Value = .CBws3.Value                            'reserve 3
        sh.Range("G24").Value = .CBws4.Value                            'reserve 4
        sh.Range("G25").Value = .CBws5.Value                            'reserve 5
        sh.Range("G26").Value = .CBws6.Value                            'reserve 6
        
        sh.Range("E25").Value = .CBcoach1.Value                         'Coach 1
        sh.Range("E26").Value = .CBcoach2.Value                         'Coach 2
   

    End With
    
  
   
   Dim sht As Worksheet
   Dim TLO As ListObject
   Dim TOR As ListRow
 
   
Set sht = Sheets("Wedstrijd data")
Set TLO = sht.ListObjects("WedstrijdataBenji")
Set TOR = TLO.ListRows.Add

irow = sht.Range("A65536").End(xlUp).Row
irow = irow

    With USFBENJAMINS                                                   'Userform Benji's
      
            
            
       sht.Range("A" & irow) = .CBpl1.Value
       sht.Range("B" & irow) = .cbTeam
       sht.Range("C" & irow) = .TBDATUM
       sht.Range("D" & irow) = .TBLOCATIE
       sht.Range("E" & irow) = .cbTYPE
         
       sht.Range("A" & irow + 1) = .CBpl2
       sht.Range("B" & irow + 1) = .cbTeam
       sht.Range("C" & irow + 1) = .TBDATUM
       sht.Range("D" & irow + 1) = .TBLOCATIE
       sht.Range("E" & irow + 1) = .cbTYPE
       
       sht.Range("A" & irow + 2) = .CBpl3
       sht.Range("B" & irow + 2) = .cbTeam
       sht.Range("C" & irow + 2) = .TBDATUM
       sht.Range("D" & irow + 2) = .TBLOCATIE
       sht.Range("E" & irow + 2) = .cbTYPE
           
       sht.Range("A" & irow + 3) = .CBpl4
       sht.Range("B" & irow + 3) = .cbTeam
       sht.Range("C" & irow + 3) = .TBDATUM
       sht.Range("D" & irow + 3) = .TBLOCATIE
       sht.Range("E" & irow + 3) = .cbTYPE
       
       sht.Range("A" & irow + 4) = .CBpl5
       sht.Range("B" & irow + 4) = .cbTeam
       sht.Range("C" & irow + 4) = .TBDATUM
       sht.Range("D" & irow + 4) = .TBLOCATIE
       sht.Range("E" & irow + 4) = .cbTYPE
           
       sht.Range("A" & irow + 5) = .CBpl6
       sht.Range("B" & irow + 5) = .cbTeam
       sht.Range("C" & irow + 5) = .TBDATUM
       sht.Range("D" & irow + 5) = .TBLOCATIE
       sht.Range("E" & irow + 5) = .cbTYPE
           
       sht.Range("A" & irow + 6) = .CBpl7
       sht.Range("B" & irow + 6) = .cbTeam
       sht.Range("C" & irow + 6) = .TBDATUM
       sht.Range("D" & irow + 6) = .TBLOCATIE
       sht.Range("E" & irow + 6) = .cbTYPE
       
       sht.Range("A" & irow + 7) = .CBpl8
       sht.Range("B" & irow + 7) = .cbTeam
       sht.Range("C" & irow + 7) = .TBDATUM
       sht.Range("D" & irow + 7) = .TBLOCATIE
       sht.Range("E" & irow + 7) = .cbTYPE
       
       If CBws1.Value = "**Geen**" Then GoTo next2 Else GoTo next1
 
next1:
       sht.Range("A" & irow + 8) = .CBws1.Value
       sht.Range("B" & irow + 8) = .cbTeam
       sht.Range("C" & irow + 8) = .TBDATUM
       sht.Range("D" & irow + 8) = .TBLOCATIE
       sht.Range("E" & irow + 8) = .cbTYPE
         
       sht.Range("A" & irow + 9) = .CBws2
       sht.Range("B" & irow + 9) = .cbTeam
       sht.Range("C" & irow + 9) = .TBDATUM
       sht.Range("D" & irow + 9) = .TBLOCATIE
       sht.Range("E" & irow + 9) = .cbTYPE
       
       sht.Range("A" & irow + 10) = .CBws3
       sht.Range("B" & irow + 10) = .cbTeam
       sht.Range("C" & irow + 10) = .TBDATUM
       sht.Range("D" & irow + 10) = .TBLOCATIE
       sht.Range("E" & irow + 10) = .cbTYPE
           
       sht.Range("A" & irow + 11) = .CBws4
       sht.Range("B" & irow + 11) = .cbTeam
       sht.Range("C" & irow + 11) = .TBDATUM
       sht.Range("D" & irow + 11) = .TBLOCATIE
       sht.Range("E" & irow + 11) = .cbTYPE
       
       sht.Range("A" & irow + 12) = .CBws5
       sht.Range("B" & irow + 12) = .cbTeam
       sht.Range("C" & irow + 12) = .TBDATUM
       sht.Range("D" & irow + 12) = .TBLOCATIE
       sht.Range("E" & irow + 12) = .cbTYPE
           
       sht.Range("A" & irow + 13) = .CBws6
       sht.Range("B" & irow + 13) = .cbTeam
       sht.Range("C" & irow + 13) = .TBDATUM
       sht.Range("D" & irow + 13) = .TBLOCATIE
       sht.Range("E" & irow + 13) = .cbTYPE
 
next2:
 
       End With
      
    
    '-----------Opslaan als pdf en JPG---------------------
    
  
  With ThisWorkbook.Sheets("Benjamins Rood")
        .ExportAsFixedFormat 0, Environ("USERPROFILE") & "\Desktop" & "\Opstellingen beta map" & "\Benjamins" & "\Opstellingen PDF" & "" & _
            .Range("J5").Value & "_" & .Range("H4").Value & "_" & .Range("J4").Value & ".pdf", OpenAfterPublish:=False
    End With
  
   
       With ThisWorkbook.Sheets("Benjamins Rood")
  Dim R As Integer
Dim intCountR As Integer
Dim objPicR As Shape
Dim objChartR As Chart
'copy the range as an image
Call ThisWorkbook.Sheets("Benjamins Rood").Range("B1:L32").CopyPicture(xlScreen, xlPicture)

'remove all previous shapes in sheet2
intCountR = ThisWorkbook.Sheets("print").Shapes.Count
For R = 1 To intCountR
    ThisWorkbook.Sheets("print").Shapes.Item(1).Delete
Next R
'create an empty chart in sheet2
ThisWorkbook.Sheets("print").Shapes.AddChart
'activate sheet2
ThisWorkbook.Sheets("print").Activate
'select the shape in sheet2
ThisWorkbook.Sheets("print").Shapes.Item(1).Select
Set objChartR = ActiveChart
'paste the range into the chart
ThisWorkbook.Sheets("print").Shapes.Item(1).Width = Range("B1:L32").Width
ThisWorkbook.Sheets("print").Shapes.Item(1).Height = Range("B1:L32").Height
objChartR.Paste
'save the chart as a JPEG
objChartR.Export Environ("USERPROFILE") & "\Desktop" & "\Opstellingen beta map" & "\Benjamins" & "\Opstellingen JPG" & "" & _
            .Range("J5").Value & "_" & .Range("H4").Value & "_" & .Range("J4").Value & ".jpg"
MsgBox ("De opstelling is opgeslagen als .JPG en PDF in de 'Opstellingen map ' ")
End With
  
      
   End If
   
 
 '---------------------Blauw-----------------
    

   If cbTeam.Value = "Blauw" Then                                       'Tabblad Benjamnins Blauw
    
    
    Set sh = ThisWorkbook.Sheets("Benjamins Blauw")                     'Tabblad Benjamnins Blauw
     
        
     Application.ScreenUpdating = False
    
    With USFBENJAMINS                                                   'Userform Benji's
    
        sh.Range("H4").Value = .cbTYPE.Value                            'Evenment info
        sh.Range("J4").Value = .TBDATUM.Value                           'Evenment info
        sh.Range("H5").Value = .TBLOCATIE.Value                         'Evenment info
        sh.Range("J5").Value = .cbTeam.Value                            'Evenment info
        
        sh.Range("F11").Value = .CBpl1.Value                            'Scrum prop
        sh.Range("G11").Value = .CBpl2.Value                            'Scrum hooker
        sh.Range("H11").Value = .CBpl3.Value                            'Scrum prop
        
        sh.Range("G14").Value = .CBpl4.Value                            'Speler 4
        sh.Range("E15").Value = .CBpl5.Value                            'Speler 5
        sh.Range("I15").Value = .CBpl6.Value                            'Speler 6
        sh.Range("D17").Value = .CBpl7.Value                            'Speler 7
        sh.Range("J17").Value = .CBpl8.Value                            'Speler 8
        
        sh.Range("E20").Value = .CBCaptain.Value                        'captain
        sh.Range("E21").Value = .CBCoCaptain.Value                      'Co-Captain
        sh.Range("E22").Value = .CBscrumhalf.Value                      'Scrumhalf
        
        sh.Range("G21").Value = .CBws1.Value                            'reserve 1
        sh.Range("G22").Value = .CBws2.Value                            'reserve 2
        sh.Range("G23").Value = .CBws3.Value                            'reserve 3
        sh.Range("G24").Value = .CBws4.Value                            'reserve 4
        sh.Range("G25").Value = .CBws5.Value                            'reserve 5
        sh.Range("G26").Value = .CBws6.Value                            'reserve 6
        
        sh.Range("E25").Value = .CBcoach1.Value                         'Coach 1
        sh.Range("E26").Value = .CBcoach2.Value                         'Coach 2
End With
[HR][/HR]
 [/COLOR]
  
   Dim sht2 As Worksheet
   Dim TLO2 As ListObject
   Dim TOR2 As ListRow
 
   
Set sht2 = Sheets("Wedstrijd data")
Set TLO2 = sht2.ListObjects("WedstrijdataBenji")
[COLOR="#FF0000"]Set TOR2 = TLO2.ListRows.Add[/COLOR]

irow = sht2.Range("A65536").End(xlUp).Row
irow = irow
   

    With USFBENJAMINS
    

   
            
       sht2.Range("A" & irow) = .CBpl1.Value
       sht2.Range("B" & irow) = .cbTeam
       sht2.Range("C" & irow) = .TBDATUM
       sht2.Range("D" & irow) = .TBLOCATIE
       sht2.Range("E" & irow) = .cbTYPE
         
       sht2.Range("A" & irow + 1) = .CBpl2
       sht2.Range("B" & irow + 1) = .cbTeam
       sht2.Range("C" & irow + 1) = .TBDATUM
       sht2.Range("D" & irow + 1) = .TBLOCATIE
       sht2.Range("E" & irow + 1) = .cbTYPE
       
       sht2.Range("A" & irow + 2) = .CBpl3
       sht2.Range("B" & irow + 2) = .cbTeam
       sht2.Range("C" & irow + 2) = .TBDATUM
       sht2.Range("D" & irow + 2) = .TBLOCATIE
       sht2.Range("E" & irow + 2) = .cbTYPE
           
       sht2.Range("A" & irow + 3) = .CBpl4
       sht2.Range("B" & irow + 3) = .cbTeam
       sht2.Range("C" & irow + 3) = .TBDATUM
       sht2.Range("D" & irow + 3) = .TBLOCATIE
       sht2.Range("E" & irow + 3) = .cbTYPE
       
       sht2.Range("A" & irow + 4) = .CBpl5
       sht2.Range("B" & irow + 4) = .cbTeam
       sht2.Range("C" & irow + 4) = .TBDATUM
       sht2.Range("D" & irow + 4) = .TBLOCATIE
       sht2.Range("E" & irow + 4) = .cbTYPE
           
       sht2.Range("A" & irow + 5) = .CBpl6
       sht2.Range("B" & irow + 5) = .cbTeam
       sht2.Range("C" & irow + 5) = .TBDATUM
       sht2.Range("D" & irow + 5) = .TBLOCATIE
       sht2.Range("E" & irow + 5) = .cbTYPE
           
       sht2.Range("A" & irow + 6) = .CBpl7
       sht2.Range("B" & irow + 6) = .cbTeam
       sht2.Range("C" & irow + 6) = .TBDATUM
       sht2.Range("D" & irow + 6) = .TBLOCATIE
       sht2.Range("E" & irow + 6) = .cbTYPE
       
       sht2.Range("A" & irow + 7) = .CBpl8
       sht2.Range("B" & irow + 7) = .cbTeam
       sht2.Range("C" & irow + 7) = .TBDATUM
       sht2.Range("D" & irow + 7) = .TBLOCATIE
       sht2.Range("E" & irow + 7) = .cbTYPE
       
       If CBws1.Value = "**Geen**" Then GoTo next4 Else GoTo next3
 
next3:
        sht2.Range("A" & irow + 8) = .CBws1.Value
       sht2.Range("B" & irow + 8) = .cbTeam
       sht2.Range("C" & irow + 8) = .TBDATUM
       sht2.Range("D" & irow + 8) = .TBLOCATIE
       sht2.Range("E" & irow + 8) = .cbTYPE
         
       sht2.Range("A" & irow + 9) = .CBws2
       sht2.Range("B" & irow + 9) = .cbTeam
       sht2.Range("C" & irow + 9) = .TBDATUM
       sht2.Range("D" & irow + 9) = .TBLOCATIE
       sht2.Range("E" & irow + 9) = .cbTYPE
       
       sht2.Range("A" & irow + 10) = .CBws3
       sht2.Range("B" & irow + 10) = .cbTeam
       sht2.Range("C" & irow + 10) = .TBDATUM
       sht2.Range("D" & irow + 10) = .TBLOCATIE
       sht2.Range("E" & irow + 10) = .cbTYPE
           
       sht2.Range("A" & irow + 11) = .CBws4
       sht2.Range("B" & irow + 11) = .cbTeam
       sht2.Range("C" & irow + 11) = .TBDATUM
       sht2.Range("D" & irow + 11) = .TBLOCATIE
       sht2.Range("E" & irow + 11) = .cbTYPE
       
       sht2.Range("A" & irow + 12) = .CBws5
       sht2.Range("B" & irow + 12) = .cbTeam
       sht2.Range("C" & irow + 12) = .TBDATUM
       sht2.Range("D" & irow + 12) = .TBLOCATIE
       sht2.Range("E" & irow + 12) = .cbTYPE
           
       sht2.Range("A" & irow + 13) = .CBws6
       sht2.Range("B" & irow + 13) = .cbTeam
       sht2.Range("C" & irow + 13) = .TBDATUM
       sht2.Range("D" & irow + 13) = .TBLOCATIE
       sht2.Range("E" & irow + 13) = .cbTYPE
next4:
 
       End With
    

    
  
    
    '-----------Opslaan als pdf en JPG---------------------
    
    
    With ThisWorkbook.Sheets("Benjamins Blauw")
        .ExportAsFixedFormat 0, Environ("USERPROFILE") & "\Desktop" & "\Opstellingen beta map" & "\Benjamins" & "\Opstellingen PDF" & "" & _
            .Range("J5").Value & "_" & .Range("H4").Value & "_" & .Range("J4").Value & ".pdf", OpenAfterPublish:=False
    End With
    
    With ThisWorkbook.Sheets("Benjamins Blauw")
  Dim B  As Integer
Dim intCountB As Integer
Dim objPicB As Shape
Dim objChartB As Chart
'copy the range as an image
Call ThisWorkbook.Sheets("Benjamins Blauw").Range("B1:L32").CopyPicture(xlScreen, xlPicture)

'remove all previous shapes in sheet2
intCountB = ThisWorkbook.Sheets("print").Shapes.Count
For B = 1 To intCountB
    ThisWorkbook.Sheets("print").Shapes.Item(1).Delete
Next B
'create an empty chart in sheet2
ThisWorkbook.Sheets("print").Shapes.AddChart
'activate sheet2
ThisWorkbook.Sheets("print").Activate
'select the shape in sheet2
ThisWorkbook.Sheets("print").Shapes.Item(1).Select
Set objChartB = ActiveChart
'paste the range into the chart
ThisWorkbook.Sheets("print").Shapes.Item(1).Width = Range("B1:L32").Width
ThisWorkbook.Sheets("print").Shapes.Item(1).Height = Range("B1:L32").Height
objChartB.Paste
'save the chart as a JPEG
objChartB.Export Environ("USERPROFILE") & "\Desktop" & "\Opstellingen beta map" & "\Benjamins" & "\Opstellingen JPG" & "" & _
            .Range("J5").Value & "_" & .Range("H4").Value & "_" & .Range("J4").Value & ".jpg"
MsgBox ("De opstelling is opgeslagen als .JPG en PDF in de 'Opstellingen map' ")
End With
    
    End If
    
    
   '-------------------Wit---------------------
   
   
   If cbTeam.Value = "Wit" Then                                         'Tabblad Benjamnins Wit
    
    
    Set sh = ThisWorkbook.Sheets("Benjamins Wit")                       'Tabblad Benjamnins Wit
     
        
     Application.ScreenUpdating = False
    
    With USFBENJAMINS                                                   'Userform Benji's
    
         
        sh.Range("H4").Value = .cbTYPE.Value                            'Evenment info
        sh.Range("J4").Value = .TBDATUM.Value                           'Evenment info
        sh.Range("H5").Value = .TBLOCATIE.Value                         'Evenment info
        sh.Range("J5").Value = .cbTeam.Value                            'Evenment info
        
        sh.Range("F11").Value = .CBpl1.Value                            'Scrum prop
        sh.Range("G11").Value = .CBpl2.Value                            'Scrum hooker
        sh.Range("H11").Value = .CBpl3.Value                            'Scrum prop
        
        sh.Range("G14").Value = .CBpl4.Value                            'Speler 4
        sh.Range("E15").Value = .CBpl5.Value                            'Speler 5
        sh.Range("I15").Value = .CBpl6.Value                            'Speler 6
        sh.Range("D17").Value = .CBpl7.Value                            'Speler 7
        sh.Range("J17").Value = .CBpl8.Value                            'Speler 8
        
        sh.Range("E20").Value = .CBCaptain.Value                        'captain
        sh.Range("E21").Value = .CBCoCaptain.Value                      'Co-Captain
        sh.Range("E22").Value = .CBscrumhalf.Value                      'Scrumhalf
        
        sh.Range("G21").Value = .CBws1.Value                            'reserve 1
        sh.Range("G22").Value = .CBws2.Value                            'reserve 2
        sh.Range("G23").Value = .CBws3.Value                            'reserve 3
        sh.Range("G24").Value = .CBws4.Value                            'reserve 4
        sh.Range("G25").Value = .CBws5.Value                            'reserve 5
        sh.Range("G26").Value = .CBws6.Value                            'reserve 6
        
        sh.Range("E25").Value = .CBcoach1.Value                         'Coach 1
        sh.Range("E26").Value = .CBcoach2.Value                         'Coach 2
    

    End With
  
    
    
    '-----------Opslaan als pdf en JPG---------------------
    
   With ThisWorkbook.Sheets("Benjamins Wit")
       .ExportAsFixedFormat 0, Environ("USERPROFILE") & "\Desktop" & "\Opstellingen beta map" & "\Benjamins" & "\Opstellingen PDF" & "" & _
            .Range("J5").Value & "_" & .Range("H4").Value & "_" & .Range("J4").Value & ".pdf", OpenAfterPublish:=False
     End With
    
       With ThisWorkbook.Sheets("Benjamins Wit")
  Dim W  As Integer
Dim intCountW As Integer
Dim objPicW As Shape
Dim objChartW As Chart
'copy the range as an image
Call ThisWorkbook.Sheets("Benjamins Wit").Range("B1:L32").CopyPicture(xlScreen, xlPicture)

'remove all previous shapes in sheet2
intCountW = ThisWorkbook.Sheets("print").Shapes.Count
For W = 1 To intCountW
    ThisWorkbook.Sheets("print").Shapes.Item(1).Delete
Next W
'create an empty chart in sheet2
ThisWorkbook.Sheets("print").Shapes.AddChart
'activate sheet2
ThisWorkbook.Sheets("print").Activate
'select the shape in sheet2
ThisWorkbook.Sheets("print").Shapes.Item(1).Select
Set objChartW = ActiveChart
'paste the range into the chart
ThisWorkbook.Sheets("print").Shapes.Item(1).Width = Range("B1:L32").Width
ThisWorkbook.Sheets("print").Shapes.Item(1).Height = Range("B1:L32").Height
objChartW.Paste
'save the chart as a JPEG
objChartW.Export Environ("USERPROFILE") & "\Desktop" & "\Opstellingen beta map" & "\Benjamins" & "\Opstellingen JPG" & "" & _
            .Range("J5").Value & "_" & .Range("H4").Value & "_" & .Range("J4").Value & ".jpg"
MsgBox ("De opstelling is opgeslagen als .JPG en PDF in de 'Opstellingen map' ")
End With
  
 
 
 
 
    
   End If
   
  Unload Me
USFBENJAMINS.Show
  

End Sub

Private Sub UserForm_Terminate()
Application.Visible = True
Sheets("Team Setup").Activate
End Sub
 

Bijlagen

  • Opstelling Maken Beta v2.xlsm
    1,5 MB · Weergaven: 14
Laatst bewerkt:
Doe ons een lol en a) verwijder die 6 meter code, of b) zet hem tussen de CODE tags, zodat hij in ieder geval leesbaar is. Dit is geen doen zo.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan