Discussion :

[Romsteack89]

Bonjour,

Je tiens à m'excusez avant de balancer mon morceau de code mais je ne sais pas comment l'optimiser...

Mon code fonctionne mais mon PC souffre

Est-ce possible de m'expliquer comment optimiser mon code svp ?

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
Public Sub MAJ_mise_en_forme()
 
DernCol = Cells(4, Columns.Count).End(xlToLeft).Column
 
 
For x = 5 To DernCol
 
 
 'mise en forme des bordures gauche et droite des équipes 1 à 3
    For L = 13 To 23 'équipe 1
            With Cells(L, x).Borders(xlEdgeLeft) 'bordure gauche
                            .Color = RGB(96, 108, 149)
                            .LineStyle = xlContinuous
                            .Weight = xlMedium
            End With
            With Cells(L, x).Borders(xlEdgeRight) 'bordure droite
                            .Color = RGB(96, 108, 149)
                            .LineStyle = xlContinuous
                            .Weight = xlMedium
            End With
    Next L
 
    For L = 25 To 35 'équipe 2
            With Cells(L, x).Borders(xlEdgeLeft) 'bordure gauche
                            .Color = RGB(96, 108, 149)
                            .LineStyle = xlContinuous
                            .Weight = xlMedium
            End With
            With Cells(L, x).Borders(xlEdgeRight) 'bordure droite
                            .Color = RGB(96, 108, 149)
                            .LineStyle = xlContinuous
                            .Weight = xlMedium
            End With
    Next L
 
    For L = 37 To 47 'équipe 3
            With Cells(L, x).Borders(xlEdgeLeft) 'bordure gauche
                            .Color = RGB(96, 108, 149)
                            .LineStyle = xlContinuous
                            .Weight = xlMedium
            End With
            With Cells(L, x).Borders(xlEdgeRight) 'bordure droite
                            .Color = RGB(96, 108, 149)
                            .LineStyle = xlContinuous
                            .Weight = xlMedium
            End With
    Next L
Next x
End Sub

C'est assez simple pour certain d'entre vous je pense, ce n'est que que la mise en forme de bordure

En vous remerciant par avance, bonne soirée.
Cordialement

[Tête de chat]

Bonjour,

deux pistes :

1. comme tu touches à l'affichage, commence avec un Application.ScreenUpdating = false et termine avec un Application.ScreenUpdating = true. Tu économiseras les mise à jour d'écran intermédiaire.

2. si j'ai bien compris, toutes les lignes sont identiques. Perso ce que je ferais c'est mettre dans un coin un modèle et le copier d'un coup. Un truc comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Public Sub MAJ_mise_en_forme(MaSheet as WorkSheet, MonModele as Range)
 
     MonModele.Copy
     MaSheet.Range("13:23").Pastespecial XlPasteformat
     MaSheet.Range("25:35").Pastespecial XlPasteformat
     MaSheet.Range("37:47").Pastespecial XlPasteformat
 
End Sub
 
Sub Test
    MAJ_mise_en_forme ThisWorkBook.sheets("Equipes"), ThisWorkBook.sheets("Modeles").range("1:1") 
End Sud

[Alex020181]

Bonjour,

En PJ un exemple d'adaptation de code pour faire ce quadrillage.

Il te suffit de cliquer sur le bouton. Tu peux tester en modifiant la position de fin en ligne 4 normalement ce sera instantané.

Teste et dis nous.

[Philippe Tulliez]

Bonjour,
Il est tout à fait possible de placer les lignes verticales sur une plage complète sans boucler ligne par ligne.

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
Sub t()
  Dim t As Variant
  Dim DerCol As Integer
  Dim e As Byte
  Dim r As Long
  ' Charge la valeur des constantes xlEdgeLeft,xlEdgeRight et xlInsideVertical
  t = Array(7, 11, 10)
  derncol = Cells(4, Columns.Count).End(xlToLeft).Column
  '
  For r = 13 To 37 Step 12
    With Range(Cells(r, 5), Cells(r + 10, derncol))
     For e = LBound(t) To UBound(t)
      With .Borders(t(e))
      .Color = RGB(96, 108, 149)
      .LineStyle = xlContinuous
      .Weight = xlMedium
      End With
     Next
    End With
  Next
End Sub

On peut également remplacer la boucle For r = 13 To 37 Step 12 par Union

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
Sub t()
  Dim t As Variant
  Dim DernCol As Integer
  Dim e As Byte
  Dim Plage As Range
  Dim Plage1 As Range, Plage2 As Range, Plage3 As Range
 
  t = Array(7, 11, 10) ' Types de bordure
  DernCol = Cells(4, Columns.Count).End(xlToLeft).Column ' Dernière colonne dynamique
 
  ' Définir les plages individuelles
  Set Plage1 = Range(Cells(13, 5), Cells(23, DernCol))
  Set Plage2 = Range(Cells(25, 5), Cells(35, DernCol))
  Set Plage3 = Range(Cells(37, 5), Cells(47, DernCol))
  ' Utiliser Union pour combiner les plages
  Set Plage = Union(Plage1, Plage2, Plage3)
  ' Appliquer les styles de bordure à la plage combinée
  With Plage
   For e = LBound(t) To UBound(t)
     With .Borders(t(e))
     .Color = RGB(96, 108, 149)
     .LineStyle = xlContinuous
     .Weight = xlMedium
     End With
   Next
  End With
  Set Plage = Nothing: Set Plage1 = Nothing: Set Plage2 = Nothing: Set Plage3 = Nothing
End Sub

Et si le PC "souffre" toujours ce qui m'étonnerait, il est toujours possible d'ajouter Application.ScreenUpdating = False

[EDIT]
Attention qu'il est extrêmement dangereux de ne pas préciser la feuille où doit être exécuté la procédure

[Alex020181]

Un petit retour ?

[Romsteack89]

Bonjour à vous et bonne année 2024 !

Je vous remercie pour vos retours et je m'excuse de ne pas vous avoir répondu plus tôt (boulot, vacances etc... )

Les deux solutions fonctionnent bien celle de Philippe Tulliez et Alex020181 et la fonction "Application.ScreenUpdating = False" aide vraiment bien.

Par contre la macro mets toujours un peu de temps pour s'effectuer (10 à 15 sec) mais je ne vous ai pas tout dis au début...

En effet, cette macro est appelée dans une autre macro avec la fonction "call", est-ce que cela peu avoir un impact ?

Ne devrait-je pas l'intégrer à la macro d'origine ?

Merci beaucoup pour votre aide.