[RESOLU] [VBA] - EXCEL 2010 - Optimisation de code

- EXCEL 2010 - Optimisation de code [RESOLU] [VBA] - VB/VBA/VBS - Programmation

Marsh Posté le 02-08-2014 à 11:20:37    

Bonjour à tous,
 
 
Je souhaiterai optimiser ce code généré automatiquement par Excel.
 
Cette macro permet de modifier les bordures de cellules sélectionnées.
Le 2e code est en 2 parties :
1) Il fait une ligne sur le haut
2) Changement de sélection, bordure gauche/centre/droite modifiée.
 
 
Merci pour votre aide.
 
Code 1 :
 
     Range("B2:D2" ).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThick
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThick
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThick
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlDash
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
Code 2
          Range("D4:G4" ).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThick
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThick
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThick
            End With
            Selection.Borders(xlInsideVertical).LineStyle = xlNone
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
             
            Range("E4:F4" ).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThick
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlDash
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone


Message édité par vb_user le 10-08-2014 à 18:17:48
Reply

Marsh Posté le 02-08-2014 à 11:20:37   

Reply

Marsh Posté le 03-08-2014 à 18:48:55    

Bonjour,
 
Ce code n'est pas trop mauvais !
 
Les principaux défauts de l'enregistreur de macro sont :
- le passage par des sélections, qu'il vaut mieux éviter.
- la génération d'un code pour la feuille active, il vaut mieux définir la feuille concernée.  
 
Pour cela tu peux désigner la feuille (corriger le nom Feuil1) et éliminer les sélections inutiles comme ça :

Code :
  1. With Worksheets("Feuil1" ).Range("B2:D2" )
  2.   .Borders(xlDiagonalDown).LineStyle = xlNone
  3.   .Borders(xlDiagonalUp).LineStyle = xlNone
  4.      With .Borders(xlEdgeLeft)
  5.        .LineStyle = xlContinuous
  6.        .ColorIndex = xlAutomatic
  7.        .TintAndShade = 0
  8.        .Weight = xlThick
  9.      End With
  10.   ...
  11.   ...
  12. End With



---------------
Cordialement, Patrice
Reply

Marsh Posté le 03-08-2014 à 20:29:10    

 
           Bonjour,
 
           Si le code est situé dans le classeur contenant la feuille de calcul à modifier,
           afin de s'affranchir du problème causé par une feuille renommée,
           mieux vaut utiliser alors son CodeName : Feuil1.Range
  

Reply

Marsh Posté le 06-08-2014 à 11:11:12    

un .BorderAround 1, xlthin
mettra toutes les bordures autour

Reply

Marsh Posté le 06-08-2014 à 14:53:00    

@pierrem75

Citation :

un .BorderAround 1, xlthin
mettra toutes les bordures autour


Tu n'a certainement pas pris le temps de lire le code,
il y a des xlthin et des xlthick, des xlContinuous et des xlDash  !!!


---------------
Cordialement, Patrice
Reply

Marsh Posté le 09-08-2014 à 11:20:42    

Bonjour et merci pour ces réponses. Je vais tenter de mettre en pratique aujourd'hui. Je vous tiens au courant.

Reply

Marsh Posté le 09-08-2014 à 12:18:18    

Tout est OK. En fait, le With remplace le "Selection". D'après ce que je lis.
 
En tout cas, merci.

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed