IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Fomat de cellules / Accélération du code [XL-2010]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé Avatar de GADENSEB
    Homme Profil pro
    Responsable Administratif et Financier
    Inscrit en
    Mars 2014
    Messages
    569
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Isère (Rhône Alpes)

    Informations professionnelles :
    Activité : Responsable Administratif et Financier
    Secteur : Finance

    Informations forums :
    Inscription : Mars 2014
    Messages : 569
    Par défaut Fomat de cellules / Accélération du code
    Hello Le Forum,

    PAr le biais du code suivant, je formate les données sur une page.
    Mais le code est un peu long à s’exécuter

    Comment l'améliorer?

    auriez-vous une idée ?

    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
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    Sub Formats()
     
    'Formatage des données
     
    'Fige l'écran pendant l'éxécution de la macro
    Application.ScreenUpdating = False
     
    'Envoie sur la page des données
    Sheets("COMPTES").Activate
     
     
     Dim n   'OK  ---- Déclare la variable n pour dénombrer les colonnes choisies dans la procédure de formatage de dates
    On Error GoTo formats_Error 'OK  ---- Si erreur goto message erreur
     
    With Sheets("COMPTES")
     
    'Format century Gothic sur toute la BDD
    .Range("A2:R" & .Range("A" & Rows.Count).End(xlUp).Row).Font.Name = _
        "Century Gothic"
    'Taille Caractére 8 sur toute la BDD
    .Range("A2:R" & .Range("A" & Rows.Count).End(xlUp).Row).Font.Size = 8
     
     
     
    'Alignement Gauche de certaines colonnes
    For Each n In Array(4, 5, 6, 7, 8, 9, 11, 12)
    .Columns(n).HorizontalAlignment = xlLeft
    Next n
     
    'Alignement Centre de certaines colonnes
    For Each n In Array(1, 2, 3, 10, 13, 14)
    .Columns(n).HorizontalAlignment = xlCenter
    Next n
     
    'Alignement Centre de certaines colonnes
    For Each n In Array(1, 2, 3, 10, 13, 14)
    .Columns(n).HorizontalAlignment = xlCenter
    Next n
     
    'Format € de certaines colonnes
    For Each n In Array(15, 16, 17, 18)
    .Columns(n).NumberFormat = "#,##0.00 €"
    Next n
     
    'Alignement Droite de certaines colonnes
    For Each n In Array(15, 16, 17, 18)
    .Columns(n).HorizontalAlignment = xlRight
    Next n
     
     
    'Format des titres de colonnes
    .Range("A1:R1").Font.Name = "Century Gothic"
    .Range("A1:R1").Font.Size = 10
    .Range("A1:R1").Interior.ColorIndex = 43
    .Range("A1:R1").HorizontalAlignment = xlCenter
    .Range("A1:R1").VerticalAlignment = xlCenter
    .Range("A1:R1").NumberFormat = "General"
     
     
     
    'Ajustement automatique des colonnes
    For Each n In Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, _
        18)
    '.Columns(n).Columns.AutoFit
    Range("A:A").ColumnWidth = 8
    Range("B:B").ColumnWidth = 11
    Range("C:C").ColumnWidth = 11
    Range("D:D").ColumnWidth = 11
    Range("E:E").ColumnWidth = 16
    Range("F:F").ColumnWidth = 11
    Range("G:G").ColumnWidth = 33
    Range("H:H").ColumnWidth = 12
    Range("I:I").ColumnWidth = 25
    Range("J:J").ColumnWidth = 8
    Range("K:K").ColumnWidth = 34
    Range("L:L").ColumnWidth = 13
    Range("M:M").ColumnWidth = 11
    Range("N:N").ColumnWidth = 7
    Range("O:O").ColumnWidth = 12
    Range("P:P").ColumnWidth = 12
    Range("Q:Q").ColumnWidth = 12
    Range("R:R").ColumnWidth = 12
     
    Next n
     
     
     
     '---Colonne A---CODE----
     'Format "General" la colonne A
     .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
         "General"
     
     '---Colonne B---DATE---
     'Choix du format des dates
     .Range("B2:B" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
         "dd/mm/yyyy"
     
     '---Colonne C---ANNEE---
     'Format "General" la colonne c
     .Range("C2:C" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
         "General"
     
     
     
    '---Toute La PLAGE DE DONNEES----
     Range("a1").CurrentRegion.Select
     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
     
    'Renvoie sur la Feuille de Synthése
    Sheets("SYNTHESE").Activate
     
    'Défige l'écran aprés l'éxécution de la macro
     Application.ScreenUpdating = True
     
     
     
    End With
     
       On Error GoTo 0
       Exit Sub
     
    formats_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure formats of Module Formats" 'OK  ---- Message d'erreur
     
    End Sub

  2. #2
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Bonjour,

    Essaie :

    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
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    Sub Formats()
     
    'Formatage des données
     
    'Fige l'écran pendant l'éxécution de la macro
    Application.ScreenUpdating = False
     
    'Envoie sur la page des données
    Sheets("COMPTES").Activate
     
     
     Dim n   'OK  ---- Déclare la variable n pour dénombrer les colonnes choisies dans la procédure de formatage de dates
    On Error GoTo formats_Error 'OK  ---- Si erreur goto message erreur
     
    With Sheets("COMPTES")
     
    'Format century Gothic sur toute la BDD
    With .Range("A2:R" & .Range("A" & Rows.Count).End(xlUp).Row).Font
        .Name = "Century Gothic"
        'Taille Caractére 8 sur toute la BDD
        .Size = 8
    End With
     
     
    'Alignement Gauche de certaines colonnes
    'For Each n In Array(4, 5, 6, 7, 8, 9, 11, 12)
    '.Columns(n).HorizontalAlignment = xlLeft
    'Next n
    .Range("D:I,K:L").HorizontalAlignment = xlCenter
    'Alignement Centre de certaines colonnes
    'For Each n In Array(1, 2, 3, 10, 13, 14)
    '.Columns(n).HorizontalAlignment = xlCenter
    'Next n
    .Range("A:C,J:J,M:N").HorizontalAlignment = xlCenter
     
    'Alignement Centre de certaines colonnes
    'For Each n In Array(1, 2, 3, 10, 13, 14)
    '.Columns(n).HorizontalAlignment = xlCenter
    'Next n
     
    ''Format € de certaines colonnes
    'For Each n In Array(15, 16, 17, 18)
    '.Columns(n).NumberFormat = "#,##0.00 €"
    'Next n
    .Range("O:R").EntireColumn.NumberFormat = "#,##0.00 €"
     
    'Alignement Droite de certaines colonnes
    'For Each n In Array(15, 16, 17, 18)
    '.Columns(n).HorizontalAlignment = xlRight
    'Next n
    .Range("O:R").EntireColumn.HorizontalAlignment = xlRight
     
    'Format des titres de colonnes
    With .Range("A1:R1")
        .Font.Name = "Century Gothic"
        .Font.Size = 10
        .Interior.ColorIndex = 43
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .NumberFormat = "General"
    End With
     
     
    'Ajustement automatique des colonnes
    'For Each n In Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, _
    '    18)
    '.Columns(n).Columns.AutoFit
    .Range("A:A,J:J").ColumnWidth = 8
    .Range("B:D,F:F,M:M").ColumnWidth = 11
    .Range("E:E").ColumnWidth = 16
    .Range("G:G").ColumnWidth = 33
    .Range("H:H,O:R").ColumnWidth = 12
    .Range("I:I").ColumnWidth = 25
    .Range("K:K").ColumnWidth = 34
    .Range("L:L").ColumnWidth = 13
    .Range("N:N").ColumnWidth = 7
     
    'Next n
     
     
     
     '---Colonne A:C---CODE----
     'Format "General" la colonne A
     .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
         "General"
     
     '---Colonne B---DATE---
     'Choix du format des dates
     .Range("B2:B" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
         "dd/mm/yyyy"
     
     '---Colonne C---ANNEE---
     'Format "General" la colonne c
    ' .Range("C2:C" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
    '     "General"
     
     
     
    '---Toute La PLAGE DE DONNEES----
     With .Range("a1").CurrentRegion
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlHairline:   End With
    End With
     
    'Renvoie sur la Feuille de Synthése
    Sheets("SYNTHESE").Activate
     
    'Défige l'écran aprés l'éxécution de la macro
     Application.ScreenUpdating = True
     
     
     
    End With
     
       On Error GoTo 0
       Exit Sub
     
    formats_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
        ") in procedure formats of Module Formats" 'OK  ---- Message d'erreur
     
    End Sub

  3. #3
    Membre éclairé Avatar de GADENSEB
    Homme Profil pro
    Responsable Administratif et Financier
    Inscrit en
    Mars 2014
    Messages
    569
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Isère (Rhône Alpes)

    Informations professionnelles :
    Activité : Responsable Administratif et Financier
    Secteur : Finance

    Informations forums :
    Inscription : Mars 2014
    Messages : 569
    Par défaut
    Hello

    Un grand merci à toi !

    Parfait et rapide, comme toujours.

    a+ seb

  4. #4
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    bonjour

    on peut simplifier pour les bordures
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    With .Range("A1").CurrentRegion
    .Borders(1).LineStyle = 1 'bordure gauche et insidevertical
    .Borders(2).LineStyle = 1 'bordure droite et insidevertical
    .Borders(3).LineStyle = 1 'bordure  top et 'insidehorizontal
    .Borders(4).LineStyle = 1 'bordure bottom et insidehorizontal
    End With
    je vais peut etre expliquer autrement car mes commentaires peuvent induire en erreur de compréhention

    borders(xledgeleft)=bordure left de la plage
    borders(1)=bordures left de toutes les cellules de la plage ou d'une celle si il y a qu'une seule cellule dans la plage en reference

    et pareil pour les autres
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  5. #5
    Membre éclairé Avatar de GADENSEB
    Homme Profil pro
    Responsable Administratif et Financier
    Inscrit en
    Mars 2014
    Messages
    569
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Isère (Rhône Alpes)

    Informations professionnelles :
    Activité : Responsable Administratif et Financier
    Secteur : Finance

    Informations forums :
    Inscription : Mars 2014
    Messages : 569
    Par défaut
    Excellent Patrick !!!

    Code au top !

    Merci !

    bonne soirée

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [Toutes versions] Valeur d'une cellule selon couleur de la cellule : Optimisation du code
    Par Invité dans le forum Excel
    Réponses: 4
    Dernier message: 24/02/2012, 10h06
  2. [XL-2007] sélectionner une cellule dans un code au lieu d'une colonne
    Par manuseverine dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 01/09/2010, 21h42
  3. [XL-MAC 2004] Création Commentaires cellules auto par code
    Par patyom dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 29/01/2010, 10h14
  4. [2.0 DataGridView] comment sélectionner une cellule par le code
    Par juniorAl dans le forum Windows Forms
    Réponses: 5
    Dernier message: 01/07/2008, 19h46
  5. insérer une fonction dans une cellule par le code
    Par RemiT dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 20/09/2007, 16h15

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo