Bonjour la Communauté,

J'ai écrit une petite macro vba mais depuis mon tableau excel affiche une lenteur incroyable. J'ai l'impression que j'ai une partie du programme qui tourne inutilement mais je ne sais où.
Quelqu'un pourrait-il me dire ce qui ralentit mon tableur?

Le code fonctionne.

Merci d'avance

Habiler

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Sub colonneOO()
    Dim ws As Worksheet
    Dim wb1 As Workbook
    Dim ws1 As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim directoryPath As String
    Dim unicodeChar As String
 
   ' unicodeChar = "=Unichar(9989)"
'
    ' Spécifiez la feuille de calcul que vous souhaitez utiliser
 
    Set ws = ThisWorkbook.Sheets("2023")
 
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
 
    directoryPath = "c:\MesFichiers\"
 
    ' Parcourir les cellules de la colonne C à partir de C2
 
     Range("O:P").ClearContents
 
        For i = 2 To lastRow
        Dim cellValue As Long
        Dim AN As String
        Dim Avis As String
        Dim Avis2023 As String
        cellValue = ws.Cells(i, "M").Value
 
 
        AN = Right(ws.Cells(i, "n"), 4) & " " & Mid(ws.Cells(i, "n"), 4, 2) & " " & Left(ws.Cells(i, "n"), 2)
        Avis = "Avis n° " & cellValue & " - " & AN & ".pdf"
        'Avis2023 = Len(Dir(directoryPath & Avis))
        Avis2023 = Dir(directoryPath & Avis)
        IfAvisExists = Not IsFileExist(Avis2023)
 
                If ws.Cells(i, "k").Value > #1/1/1900# Then   ' If 2
 
                        If ws.Cells(i, "L").Value > 0 Then        ' If 3
 
                                   If ws.Cells(i, "M").Value > 0 Then
                                            If Not IfAvisExists Then 'If 1
                                                     ws.Cells(i, "P") = "Publication stoppée"
                                                     ws.Cells(i, "P").Font.Color = RGB(255, 0, 0)
                                                     ws.Cells(i, "P").Font.Bold = True
 
 
                                            Else
                                                     ws.Cells(i, "P") = "Publié"
                                                     ws.Cells(i, "P").Font.Color = RGB(85, 107, 47)
                                                     ws.Cells(i, "P").Font.Bold = True
                                            End If
 
                                   Else
 
                                        ws.Cells(i, "P") = "Signé mais non Publié"
                                        ws.Cells(i, "P").Font.Color = RGB(255, 0, 0)
                                        ws.Cells(i, "P").Font.Bold = True
                                    End If
                        Else
                        ws.Cells(i, "P") = "A la signature du CEO"
                        ws.Cells(i, "P").Font.Color = RGB(70, 130, 180)
                         ws.Cells(i, "P").Font.Bold = True
                        End If
                        Else
                        ws.Cells(i, "P") = "En préparation"
                        ws.Cells(i, "P").Font.Color = RGB(0, 0, 255)
                        ws.Cells(i, "P").Font.Bold = True
                        End If
               Next i
End Sub
 
 
Function IsFileExist(FullName As String) As Boolean
  ' Vérifie l'existence d'un fichier
  IsFileExist = Dir(FullName) <> ""
End Function
 
'Private Sub Worksheet_Change(ByVal Target As Range)
'    If Not Intersect(Target, Range("M:M")) Is Nothing Then colonneOO
'End Sub