halecs93
XLDnaute Impliqué
Bonjour à toutes et à à tous,
Je m'arrache les cheveux et ne comprend pas pourquoi mon fichier Excel (réalisé avec l'aide précieuse des membres du forum) plante. Le code Vba associé à la feuille "planning" semble s’exécuter normalement, mais à partir de la cellule F119, plus rien ne va.
Help, help, help !
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plan As Worksheet, auxil As Worksheet, coll As New Collection
Dim xrgValid As Range, n&, x, i&, k&
Dim cellsBtoN As Range
Dim cell As Range
Dim cellQ As Range
Application.ScreenUpdating = False
Set plan = Worksheets("PLANNING")
On Error Resume Next: Application.DisplayAlerts = False
Application.Worksheets("Auxilxxx").Delete
Application.DisplayAlerts = True: On Error GoTo 0
With Application.Worksheets.Add: .Name = "Auxilxxx": End With
Set auxil = Worksheets("Auxilxxx")
' Code existant pour la mise en forme conditionnelle
plan.Range("B3:N" & Rows.count).Font.Color = vbBlack
plan.Range("B3:N" & Rows.count).Font.Bold = False
Set xrgValid = plan.[B5].SpecialCells(xlCellTypeSameValidation)
ReDim t(1 To 3 * plan.UsedRange.Rows.count / 3, 1 To 6)
auxil.Cells.Delete
For Each x In xrgValid.Cells
If x.Value <> "" Then
If x.Offset(-1) <> "" Then
n = n + 1
t(n, 1) = x.Column
t(n, 2) = x.Value
t(n, 3) = TimeValue(Split(x.Offset(-1), "-")(0))
t(n, 4) = TimeValue(Split(x.Offset(-1), "-")(1))
t(n, 5) = x.Row
t(n, 6) = Format(t(n, 1), "0000") & String(50 - Len(t(n, 2)), " ") & t(n, 2) & Format(t(n, 3), "hhmm") & Format(t(n, 4), "hhmm")
End If
End If
Next x
auxil.[A1].Resize(n, 6) = t
auxil.[A1].Resize(n, 6).Sort key1:=auxil.[F1], order1:=xlAscending, MatchCase:=False, Header:=xlNo
t = auxil.[A1].Resize(n, 5).Value
On Error Resume Next: Application.DisplayAlerts = False
auxil.Delete
Application.DisplayAlerts = True: On Error GoTo 0
For i = 2 To UBound(t)
If t(i, 1) = t(i - 1, 1) And t(i, 2) = t(i - 1, 2) And t(i, 3) < t(i - 1, 4) Then
plan.Cells(t(i, 5), t(i, 1)).Font.Color = vbRed
plan.Cells(t(i, 5), t(i, 1)).Font.Bold = True
plan.Cells(t(i - 1, 5), t(i - 1, 1)).Font.Color = vbRed
plan.Cells(t(i - 1, 5), t(i - 1, 1)).Font.Bold = True
On Error Resume Next
coll.Add "", t(i, 5) & "/" & t(i, 1)
coll.Add "", t(i - 1, 5) & "/" & t(i - 1, 1)
On Error GoTo 0
End If
Next i
' Nouveau code pour la mise en forme conditionnelle basée sur la liste déroulante
Set cellsBtoN = plan.Range("B:N")
If Not Intersect(Target, cellsBtoN) Is Nothing Then
For Each cell In Intersect(Target, cellsBtoN)
Set cellQ = plan.Columns("Q:Q").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not cellQ Is Nothing Then
cell.Interior.Color = cellQ.Interior.Color
End If
Next cell
End If
Application.ScreenUpdating = True
End Sub
Excel m'indique une erreur à la ligne t(n, 1) = x.Column
Un grand merci
Je m'arrache les cheveux et ne comprend pas pourquoi mon fichier Excel (réalisé avec l'aide précieuse des membres du forum) plante. Le code Vba associé à la feuille "planning" semble s’exécuter normalement, mais à partir de la cellule F119, plus rien ne va.
Help, help, help !
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plan As Worksheet, auxil As Worksheet, coll As New Collection
Dim xrgValid As Range, n&, x, i&, k&
Dim cellsBtoN As Range
Dim cell As Range
Dim cellQ As Range
Application.ScreenUpdating = False
Set plan = Worksheets("PLANNING")
On Error Resume Next: Application.DisplayAlerts = False
Application.Worksheets("Auxilxxx").Delete
Application.DisplayAlerts = True: On Error GoTo 0
With Application.Worksheets.Add: .Name = "Auxilxxx": End With
Set auxil = Worksheets("Auxilxxx")
' Code existant pour la mise en forme conditionnelle
plan.Range("B3:N" & Rows.count).Font.Color = vbBlack
plan.Range("B3:N" & Rows.count).Font.Bold = False
Set xrgValid = plan.[B5].SpecialCells(xlCellTypeSameValidation)
ReDim t(1 To 3 * plan.UsedRange.Rows.count / 3, 1 To 6)
auxil.Cells.Delete
For Each x In xrgValid.Cells
If x.Value <> "" Then
If x.Offset(-1) <> "" Then
n = n + 1
t(n, 1) = x.Column
t(n, 2) = x.Value
t(n, 3) = TimeValue(Split(x.Offset(-1), "-")(0))
t(n, 4) = TimeValue(Split(x.Offset(-1), "-")(1))
t(n, 5) = x.Row
t(n, 6) = Format(t(n, 1), "0000") & String(50 - Len(t(n, 2)), " ") & t(n, 2) & Format(t(n, 3), "hhmm") & Format(t(n, 4), "hhmm")
End If
End If
Next x
auxil.[A1].Resize(n, 6) = t
auxil.[A1].Resize(n, 6).Sort key1:=auxil.[F1], order1:=xlAscending, MatchCase:=False, Header:=xlNo
t = auxil.[A1].Resize(n, 5).Value
On Error Resume Next: Application.DisplayAlerts = False
auxil.Delete
Application.DisplayAlerts = True: On Error GoTo 0
For i = 2 To UBound(t)
If t(i, 1) = t(i - 1, 1) And t(i, 2) = t(i - 1, 2) And t(i, 3) < t(i - 1, 4) Then
plan.Cells(t(i, 5), t(i, 1)).Font.Color = vbRed
plan.Cells(t(i, 5), t(i, 1)).Font.Bold = True
plan.Cells(t(i - 1, 5), t(i - 1, 1)).Font.Color = vbRed
plan.Cells(t(i - 1, 5), t(i - 1, 1)).Font.Bold = True
On Error Resume Next
coll.Add "", t(i, 5) & "/" & t(i, 1)
coll.Add "", t(i - 1, 5) & "/" & t(i - 1, 1)
On Error GoTo 0
End If
Next i
' Nouveau code pour la mise en forme conditionnelle basée sur la liste déroulante
Set cellsBtoN = plan.Range("B:N")
If Not Intersect(Target, cellsBtoN) Is Nothing Then
For Each cell In Intersect(Target, cellsBtoN)
Set cellQ = plan.Columns("Q:Q").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not cellQ Is Nothing Then
cell.Interior.Color = cellQ.Interior.Color
End If
Next cell
End If
Application.ScreenUpdating = True
End Sub
Excel m'indique une erreur à la ligne t(n, 1) = x.Column
Un grand merci