Ajout d'une fonction sur une macro
Hello,
J'ai cette maco en place :
Sub AlternatingRowHighlight()
Dim rng As Range
Dim cell As Range
Dim rowNum As Integer
Dim isHighlighted As Boolean
' Vérifie si une cellule de la sélection est déjà en surbrillance
isHighlighted = False
For Each cell In Selection
If cell.Interior.Color = RGB(180, 180, 180) Then
isHighlighted = True
Exit For
End If
Next cell
' Si aucune cellule n'est en surbrillance, on les met
If Not isHighlighted Then
For Each rng In Selection.Rows
rowNum = rng.Row
If rowNum Mod 2 = 0 Then ' Ligne paire
rng.Interior.Color = RGB(180, 180, 180)
End If
Next rng
Else ' Si des cellules sont en surbrillance, on les retire
For Each rng In Selection.Rows
rng.Interior.ColorIndex = xlNone
Next rng
End If
End Sub
Elle me permet de mettre en surbrillance alternées les lignes sélectionnées.
Cependant, si les cellules avaient déjà un format, quand je ré exécute la macro, tous les formats disparaissent.
Je voudrais que les couleurs de remplissages qu'il y a avant l'exécution de la macro soient enregistrés et repris lors de la ré exécution.
Pouvez-vous m'aider ?
Merci à tous d'avance !!!
Voici ce que ChatGPT m'a proposé mais la ligne en gras pose problème ...
Sub AlternatingRowHighlight()
Dim rng As Range
Dim cell As Range
Dim rowNum As Integer
Dim isHighlighted As Boolean
Dim originalColors() As Long ' Tableau pour stocker les couleurs d'origine
Dim originalFormats() As Variant ' Tableau pour stocker les formats d'origine
' Vérifie si une cellule de la sélection est déjà en surbrillance
isHighlighted = False
For Each cell In Selection
If cell.Interior.Color = RGB(180, 180, 180) Then
isHighlighted = True
Exit For
End If
Next cell
' Si aucune cellule n'est en surbrillance, on les met
If Not isHighlighted Then
' Enregistrer les couleurs d'origine et les formats des cellules sélectionnées
ReDim originalColors(1 To Selection.Cells.Count)
ReDim originalFormats(1 To Selection.Cells.Count)
Dim i As Integer
i = 1
For Each rng In Selection
originalColors(i) = rng.Interior.Color
originalFormats(i) = rng.NumberFormat ' Enregistrer le format de la cellule
i = i + 1
Next rng
For Each rng In Selection.Rows
rowNum = rng.Row
If rowNum Mod 2 = 0 Then ' Ligne paire
rng.Interior.Color = RGB(180, 180, 180)
End If
Next rng
Else ' Si des cellules sont en surbrillance, on les retire
' Restaurer les couleurs d'origine et les formats des cellules sélectionnées
Dim j As Integer
j = 1
For Each rng In Selection
If j <= UBound(originalColors) Then
rng.Interior.Color = originalColors(j)
rng.NumberFormat = originalFormats(j) ' Rétablir le format de la cellule
End If
j = j + 1
Next rng
End If
End Sub
Bonjour Nathan.D
ChatGpt a encore frappé. On nous refile un code qui ne marche pas et à nous de le décortiquer et de le corriger.
Avez-vous au moins demandé à ChatGPT de trouver son erreur ? (c'est une boutade)
Une piste : à la première exécution de la macro, la macro sauvegarde les couleurs d'origine dans une variable de type array dynamique nommée originalColors() mais dont la durée de vie n'excède pas la durée d'exécution de la macro.
Comment voulez-vous alors récupérer les informations de couleurs à partir d'une variable qui a été effacée à la fin de la première exécution de la macro ?
Il faut trouver une manière de sauvegarder les couleurs par un moyen qui perdure au-delà de l'exécution de la macro.
nota : je ne connais pas ChatGPT (uniquement les codes VBA issus de ChatGPT
Autre point : votre macro travaille sur la sélection active : c'est dangereux car une erreur est si vite faite. Imaginons que la sélection active ne soient pas la bonne, la macro va s'exécuter sur cette sélection et peut causer des modifications sur lesquelles on ne pourra pas revenir. Il vaut mieux demander à la macro de sélectionner la bonne plage par elle-même. Encore faudrait-il fournit un fichier représentatif...
Ma macro est ok, merci pour vos conseils !!!