Beste,
Ik heb over dit onderwerp al eens gepost op 25 januari 2025. Daar is geen oplossing uitgekomen. Nu ben ik zover dat ik een werkende versie heb met uitzondering van dat de lijnen niet goed getekend worden als een rij verborgen is. Het gaat dan hierbij om "Rij-1" zoals in de macro opgenomen. wat ik wil is dat de macro zoekt naar de eerst zichtbare rij boven "Rij" Het is een heel lange macro geworden. Zie ook het bijgesloten bestand. ik heb nu rij 19 t/m 21 verborgen. Rij 18 moet in dit geval "Rij-1"zijn. Met de knop boven in kun je de macro ook uitvoeren. Ik heb de macro hieronder afgekapt na scenario1 er zijn er in totaal 7 met meerdere varianten.
Ik heb over dit onderwerp al eens gepost op 25 januari 2025. Daar is geen oplossing uitgekomen. Nu ben ik zover dat ik een werkende versie heb met uitzondering van dat de lijnen niet goed getekend worden als een rij verborgen is. Het gaat dan hierbij om "Rij-1" zoals in de macro opgenomen. wat ik wil is dat de macro zoekt naar de eerst zichtbare rij boven "Rij" Het is een heel lange macro geworden. Zie ook het bijgesloten bestand. ik heb nu rij 19 t/m 21 verborgen. Rij 18 moet in dit geval "Rij-1"zijn. Met de knop boven in kun je de macro ook uitvoeren. Ik heb de macro hieronder afgekapt na scenario1 er zijn er in totaal 7 met meerdere varianten.
Code:
Private Sub BerekenEnVoegConnectorToe9_end()
Application.EnableEvents = False
Dim huidigeDatum As Date
Dim berekendeDatumStart As Date
Dim berekendeDatumRij As Date
Dim ws As Worksheet
Dim feestdagenWs As Worksheet
Dim row As Long
Dim connector As Shape
Dim targetColumnStart As Long
Dim targetColumnRij As Long
Dim found As Boolean
Dim startDatum As Date
Dim fractie As Double
Dim aantalDagen As Double
Dim dagenToevoegen As Long
Dim feestdagenRange As Range
Dim startX As Double, startY As Double
Dim endX As Double, endY As Double
Dim connectorVert As Shape
Dim connectorHor As Shape
Dim huidigeDatumKolom As Long
Dim LastRow As Long
Set ws = ThisWorkbook.Sheets("Projectplanning")
Set feestdagenWs = ThisWorkbook.Sheets("Feestdagen")
huidigeDatum = Date
found = False
For huidigeDatumKolom = 1 To ws.Columns.Count
If IsDate(ws.Cells(6, huidigeDatumKolom).Value) Then
If ws.Cells(6, huidigeDatumKolom).Value = huidigeDatum Then
found = True
Exit For
End If
End If
Next huidigeDatumKolom
If Not found Then
MsgBox "De huidige datum werd niet gevonden in rij 6."
Application.EnableEvents = True
Exit Sub
End If
For Each connector In ws.Shapes
If connector.Name = "Status10" Then connector.Delete
Next connector
Set feestdagenRange = feestdagenWs.Range("B3:B126")
LastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).row
For row = 9 To LastRow - 1
If Not ws.Rows(row).Hidden Then
If ws.Cells(row - 1, "E").Value <> "" Then
If IsDate(ws.Cells(row - 1, "E").Value) Then
startDatum = ws.Cells(row - 1, "E").Value
Else
MsgBox "Ongeldige datum in rij " & row - 1 & " van kolom E", vbExclamation
Exit Sub
End If
fractie = ws.Cells(row - 1, "H").Value
If ws.Cells(row - 1, "J").Value > 0 Then
aantalDagen = ws.Cells(row - 1, "G").Value + ws.Cells(row - 1, "J").Value
Else
aantalDagen = ws.Cells(row - 1, "G").Value
End If
dagenToevoegen = Application.WorksheetFunction.Floor(fractie * aantalDagen, 1)
berekendeDatumStart = Application.WorksheetFunction.WorkDay(startDatum, dagenToevoegen, feestdagenRange)
berekendeDatumStart = Application.WorksheetFunction.Floor(berekendeDatumStart, 1)
If berekendeDatumStart > huidigeDatum Then
berekendeDatumStart = huidigeDatum
End If
End If
If ws.Cells(row, "E").Value <> "" Then
If IsDate(ws.Cells(row, "E").Value) Then
startDatum = ws.Cells(row, "E").Value
Else
MsgBox "Ongeldige datum in rij " & row & " van kolom E", vbExclamation
Exit Sub
End If
fractie = ws.Cells(row, "H").Value
If ws.Cells(row, "J").Value > 0 Then
aantalDagen = ws.Cells(row, "G").Value + ws.Cells(row, "J").Value
Else
aantalDagen = ws.Cells(row, "G").Value
End If
dagenToevoegen = Application.WorksheetFunction.Floor(fractie * aantalDagen, 1)
berekendeDatumRij = Application.WorksheetFunction.WorkDay(startDatum, dagenToevoegen, feestdagenRange)
berekendeDatumRij = Application.WorksheetFunction.Floor(berekendeDatumRij, 1)
If berekendeDatumRij > huidigeDatum Then
berekendeDatumRij = huidigeDatum
End If
End If
' Zoek de kolom in rij 6 die overeenkomt met de berekende datum voor rij-1 (startdatum)
found = False
For targetColumnStart = 1 To ws.Columns.Count
If IsDate(ws.Cells(6, targetColumnStart).Value) Then
If ws.Cells(6, targetColumnStart).Value = berekendeDatumStart Then
found = True
Exit For
End If
End If
Next targetColumnStart ' Einde van de For-lus voor targetColumnStart
If Not found Then
MsgBox "De berekende datum voor rij-1 werd niet gevonden in rij 6."
Exit Sub
End If
' Zoek de kolom in rij 6 die overeenkomt met de berekende datum voor de huidige rij
found = False
For targetColumnRij = 1 To ws.Columns.Count
If IsDate(ws.Cells(6, targetColumnRij).Value) Then
If ws.Cells(6, targetColumnRij).Value = berekendeDatumRij Then
found = True
Exit For
End If
End If
Next targetColumnRij ' Einde van de For-lus voor targetColumnRij
If Not found Then
MsgBox "De berekende datum voor rij " & row & " werd niet gevonden in rij 6."
Exit Sub
End If
' Gebruik Select Case om te bepalen welk scenario van toepassing is
Select Case True
' Scenario 1: Rij -1 voortgang 100% en rij voortgang 100% -> plaats alleen verticale connector in de huidige datum kolom
Case ws.Cells(row - 1, "E").Value < huidigeDatum And ws.Cells(row - 1, "H").Value = 1 And ws.Cells(row, "E").Value < huidigeDatum And ws.Cells(row, "H").Value = 1
startX = ws.Cells(6, huidigeDatumKolom).Left + ws.Cells(6, huidigeDatumKolom).Width - 12
startY = ws.Cells(row - 1, huidigeDatumKolom).Top + 12
endY = ws.Cells(row, huidigeDatumKolom).Top + 12 ' De eindpositie van de verticale connector
Set connectorVert = ws.Shapes.AddConnector(msoConnectorStraight, startX, startY, startX, endY)
connectorVert.Line.ForeColor.RGB = RGB(255, 0, 0)
connectorVert.Line.Weight = 2
connectorVert.Name = "Status10"
End Select
End If
Next row
Application.EnableEvents = True
End Sub