Probleem bij speelveldplanning?

[apmgiliams]

Wie kan mij helpen bij het volgende probleem?

Bijgevoegd als bijlage iets om een veldplanninng te maken, d.m.v. voorwaardelijkeopmaak kan het maar is niet mooi. Ik weet niet of het mogelijk is om via ALS etc een macro in te passen.
Bekijk de bijlage eens waarin een en ander duidelijker beschreven staat wat ik wil en tevens visueel duidelijker overkomt dan middels tekst.

Er zijn twee tabbladen welk met elkaar verbonden zijn, invullen bij clublad moet in het andere blad informatie doorlussen.

A.Giliams

 

[jzeedijk]

Hoi,

Het verbeterde bestand.

Jeroen

 

[apmgiliams]

veldplanning

Jeroen,
na het bekijken van jou file loop ik tegen het volgende op. Volgend seizoen kan het zijn dat er meer teams ingeschreven worden, hoe kan ik makkelijk die uitbreiding krijgen. Of moet ik in zowel het clubblad!, veldplanninng en tweede veld rijen invoegen en formules invoegen en tevens in de macro's en VBA waarden hiervoor aanpassen.
In jou macro's en VBA kan ik redelijk begrijpen hoe het in elkaar steekt, maar zelf maken is een tweede.

vr.gr.Alex

P.S.: Tevens kwam ik er achter dat als ik het schema wil beveiligen de macro's vastlopen op de Merge functie.
Jammer, omdat ik het schema eigenlijk tegen per ongeluk veranderen wil beschermen.

 

[jzeedijk]

Hoi Alex,

Uitleg van de macro:
(rechtermuisknop klik op schema, programmacode)

Private Sub Worksheet_Activate()
rij = ActiveCell.Row: Kol = ActiveCell.Column:'overbodig

:'TOEVOEGEN:
ActiveSheet.Unprotect Password:="test"
:'heft de beveiliging van het werkblad op (wachtwoord is test)

Range("I5").MergeCells = False:'Voorkomt een foutmelding als I5 toevallig een gedeelde cel is.

Range("I78X114").Select
Selection.Copy
Range("I5").Select
ActiveSheet.Paste
:'Het gebied I78X114 is een leeg speelveldoverzicht. Wil je meer velden toevoegen dan moet je dat hier veranderen in bijvoorbeeld I78X116. Met deze regels wordt het lege speelveld overzicht gekopieerd over het oude.

For i = 5 To 41:'De macro wordt uitgevoerd voor de regels 5 t/m 41, dit kun je uitbreiden naar bijvoorbeeld 5 to 43 voor twee extra velden
If Not Cells(i, 5) = "-" Then
Bt = Round((Cells(i, 5) - 1 / 3) / 5 * 24 * 60, 0) + 9
If Bt < 9 Then Bt = 9
Et = Round((Cells(i, 132) - 1 / 3) / 5 * 24 * 60, 0) + 8
If Et > 128 Then Et = 128
If Cells(i, 6) = "T" Then TU = 27
If Cells(i, 7) = "U" Then TU = 15
:'Hier wordt de vorm van de balk bepaald, de kolommen beginnen in kolom I (9) en eindigen in kolom CX (128)

Range(Cells(i, Bt), Cells(i, Et)).Select
:'het selecteren van een aantal cellen op een rij binnen begintijd Bt en Eindtijd Et.

With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
:'het samenvoegen van cellen tot een balk

If Bt > 9 Then
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
If i > 5 Then
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
If i < 41 Then
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
If Et < 128 Then
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
:'het maken van een kader om de balk

With Selection.Interior
.ColorIndex = TU
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
:'De basiskleur van de balk

Selection.Font.Bold = True
If TU = 27 Then ActiveCell.FormulaR1C1 = "Thuis" Else ActiveCell.FormulaR1C1 = "Uit"
:' Invullen van tekst in de balk

Range("I5").Select:'kan ook na Next i gezet worden
End If
Next i

:'TOEVOEGEN:
ActiveSheet.Protect Password:="test"
:'beveiligt het werkblad (wachtwoord is test)

End Sub

In principe hoef je niet veel te wijzigen om extra velden aan het macro toe te voegen.

Jeroen