VBA excel insertion de ligne et couleur
Résolu/Fermé
grand-agite
grand-agite
- Messages postés
- 3
- Date d'inscription
- mardi 7 décembre 2010
- Statut
- Membre
- Dernière intervention
- 9 décembre 2010
grand-agite
- Messages postés
- 3
- Date d'inscription
- mardi 7 décembre 2010
- Statut
- Membre
- Dernière intervention
- 9 décembre 2010
A voir également:
- VBA excel insertion de ligne et couleur
- VBA excel insertion de ligne et couleur ✓ - Forum - VB / VBA
- Vba Excel :Insertion de lignes entre 2 lignes non vides ✓ - Forum - VB / VBA
- Vba excel: copier les lignes de couleur. ✓ - Forum - Excel
- VBA excel : insertion de 5 lignes + transposition ✓ - Forum - Excel
- Aide VBA Excel: insertion d'une nouvelle ligne ✓ - Forum - VB / VBA
3 réponses
grand-agite
Modifié par grand-agite le 8/12/2010 à 12:12
- Messages postés
- 3
- Date d'inscription
- mardi 7 décembre 2010
- Statut
- Membre
- Dernière intervention
- 9 décembre 2010
Modifié par grand-agite le 8/12/2010 à 12:12
Up
J'en profite pour poster le début de programme que j'ai réussi a faire en lisant beaucoup de message sur internet :
Option Explicit
Sub test2()
Dim chx As Integer
Dim I As Integer
Dim J As Integer
Dim C As Integer
Dim Z As Double
Dim L As Integer
Dim Y As Integer
Dim R As Variant
chx = 1
Do While (chx <> 0)
chx = InputBox("Vous voulez ?" & Chr(13) & "0 : Sortir" & Chr(13) & "1 : Insérer une ligne " & Chr(13) & _
"2 : Supprimer une ligne ")
If (chx = 0) Then
ElseIf (chx = 1) Then 'Inserer une ligne'
L = InputBox("Ligne ?")
Rows(L).Select
Selection.Insert Shift:=xlDown
C = 2 ' x=2 car c'est toujours la même colonne sinon faire inputbox ("Colonne ? ")'
Z = L - 1
Y = L + 1
Cells(L, C).Select
R = InputBox("Référence ?")
Cells(L, C).Value = R
Cells(L, C).Select
If Cells(Z, C).Value = R Then ' Comparaison de la cellule de la ligne insérée avec la cellule du dessous '
Cells(Z, C).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
If Cells(Y, C).Value = R Then ' Comparaison de la cellule de la ligne insérée avec la cellule du dessus '
Cells(Y, C).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If
End If
Avec ce programme je peu : insérer une ligne , donner une référence , et insérer cette derniere dans la bonne cellule. Là où ca pèche c'est au changement de couleur : ca ne fonctionne pas , je ne comprend pas pourquoi (peut être ça vien du fait que les cellules insérées posséde une mise en forme conditionnel... comment insérer une ligne sans format sans rien..?) :(
J'en profite pour poster le début de programme que j'ai réussi a faire en lisant beaucoup de message sur internet :
Option Explicit
Sub test2()
Dim chx As Integer
Dim I As Integer
Dim J As Integer
Dim C As Integer
Dim Z As Double
Dim L As Integer
Dim Y As Integer
Dim R As Variant
chx = 1
Do While (chx <> 0)
chx = InputBox("Vous voulez ?" & Chr(13) & "0 : Sortir" & Chr(13) & "1 : Insérer une ligne " & Chr(13) & _
"2 : Supprimer une ligne ")
If (chx = 0) Then
ElseIf (chx = 1) Then 'Inserer une ligne'
L = InputBox("Ligne ?")
Rows(L).Select
Selection.Insert Shift:=xlDown
C = 2 ' x=2 car c'est toujours la même colonne sinon faire inputbox ("Colonne ? ")'
Z = L - 1
Y = L + 1
Cells(L, C).Select
R = InputBox("Référence ?")
Cells(L, C).Value = R
Cells(L, C).Select
If Cells(Z, C).Value = R Then ' Comparaison de la cellule de la ligne insérée avec la cellule du dessous '
Cells(Z, C).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
If Cells(Y, C).Value = R Then ' Comparaison de la cellule de la ligne insérée avec la cellule du dessus '
Cells(Y, C).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If
End If
Avec ce programme je peu : insérer une ligne , donner une référence , et insérer cette derniere dans la bonne cellule. Là où ca pèche c'est au changement de couleur : ca ne fonctionne pas , je ne comprend pas pourquoi (peut être ça vien du fait que les cellules insérées posséde une mise en forme conditionnel... comment insérer une ligne sans format sans rien..?) :(
lermite222
Modifié par lermite222 le 8/12/2010 à 14:15
- Messages postés
- 8702
- Date d'inscription
- dimanche 8 avril 2007
- Statut
- Contributeur
- Dernière intervention
- 22 janvier 2020
Modifié par lermite222 le 8/12/2010 à 14:15
Bonjour,
Colle ce code dans le module de la feuille, adapte la 1ère ligne (Ici la 4) et les couleurs de texte et de fond
Mettre le curseur sur la cellule où ajouter ou supprimer ensuite..
J'ai mis la macro Insertion avec le raccourci Ctrl+i et
Supprime avec Ctrl+S
Tu dis,
A+
Edit: j'oubliais, je teste la colonne A
L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
Colle ce code dans le module de la feuille, adapte la 1ère ligne (Ici la 4) et les couleurs de texte et de fond
Option Explicit Sub Insertion() Rows(ActiveCell.Row).Insert Shift:=xlDown Colorise End Sub Sub Colorise() Dim Lig As Long Dim Coul(1) As Integer, Fond(1) As Integer, NumCoul As Byte Coul(0) = 9: Fond(0) = 8 Coul(1) = 3: Fond(1) = 4 For Lig = 4 To Range("A65536").End(xlUp).Row If Cells(Lig, "A").Offset(-1) <> Cells(Lig, "A") Then NumCoul = NumCoul + 1 If NumCoul > 1 Then NumCoul = 0 End If Rows(Lig).Font.ColorIndex = Coul(NumCoul) Rows(Lig).Interior.ColorIndex = Fond(NumCoul) Next Lig End Sub Sub Supprime() 'éventuellement message confirmation suppression Rows(ActiveCell.Row).Delete Colorise End Sub
Mettre le curseur sur la cellule où ajouter ou supprimer ensuite..
J'ai mis la macro Insertion avec le raccourci Ctrl+i et
Supprime avec Ctrl+S
Tu dis,
A+
Edit: j'oubliais, je teste la colonne A
L'expérience instruit plus sûrement que le conseil. (André Gide)
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
grand-agite
9 déc. 2010 à 17:54
- Messages postés
- 3
- Date d'inscription
- mardi 7 décembre 2010
- Statut
- Membre
- Dernière intervention
- 9 décembre 2010
9 déc. 2010 à 17:54
Merci de ta réponse Lermitte222
Ce code fonctionne bel et bien. Cependant j'ai trouvé une alternative que je vais poster ici , ça fonctionne :
Sub coloriage()
Application.ScreenUpdating = False
Couleur = 40
For i = 2 To [A65000].End(xlUp).Row
If Cells(i, 1) <> Cells(i - 1, 1) Then Couleur = IIf(Couleur = 35, 40, 35)
Cells(i, 1).Interior.ColorIndex = Couleur
Next i
Application.ScreenUpdating = True
End Sub
J'insert une ligne (entre deux lignes deja présente par ex ) , je rentre mes données , et j'ai qu'a lancé la macro par le biais d'un bouton pour que toutes les couleurs se mettent à jours :D
Voila voila , le sujet est résolu ! Merci à toi Lermitte222 pour ta rapide réponse.
Ce code fonctionne bel et bien. Cependant j'ai trouvé une alternative que je vais poster ici , ça fonctionne :
Sub coloriage()
Application.ScreenUpdating = False
Couleur = 40
For i = 2 To [A65000].End(xlUp).Row
If Cells(i, 1) <> Cells(i - 1, 1) Then Couleur = IIf(Couleur = 35, 40, 35)
Cells(i, 1).Interior.ColorIndex = Couleur
Next i
Application.ScreenUpdating = True
End Sub
J'insert une ligne (entre deux lignes deja présente par ex ) , je rentre mes données , et j'ai qu'a lancé la macro par le biais d'un bouton pour que toutes les couleurs se mettent à jours :D
Voila voila , le sujet est résolu ! Merci à toi Lermitte222 pour ta rapide réponse.