Colonne A et B couleur une ligne sur deux

Re,

Je ne comprends pas très bien, le code ci dessous colorise 1 cellule sur 2 à partir de la deuxième ligne si les cellules de la colonne A sont renseignée (ne sont pas vide)
si tu écris [C1].select la cellule C1 sera colorisée

Sub Selection_1_sur_X()
Dim i As Integer
[A2].Select
x = Range("A65536").End(xlUp).Row
For i = 2 To x Step 2
Union(Selection, Range("A" & i, "B" & i)).Interior.ColorIndex = 3
Next i
End Sub

Re,

Tu peux expliquer ce que tu veux faire, coloriser la ligne active avec une couleur différente

Pourrai t'on svp remplacer par un petit code qui ferai monter et descendre une barre de couleur unique pour me déplacer dans mes colonnes A et B.

Re,

on va faire quelque chose de très simple, commence par remplacer le code macro précédent ou ajoute cette ligne

[A1].Interior.ColorIndex = xlNone

Sub Selection_1_sur_X()
Dim i As Integer
[A1].Select
x = Range("A65536").End(xlUp).Row
For i = 2 To x Step 2
Union(Selection, Range("A" & i, "B" & i)).Interior.ColorIndex = 3
Next i
[A1].Interior.ColorIndex = xlNone
End Sub

ensuite mettre le tableau concerné en surbrillance exemple A1 à B1000 (on pourra modifier plus tard)

colle cette formule

=LIGNE()=CELLULE("ligne")

et choisir une couleur de remplissage exemple bleu

ensuite clic droit sur l'onglet de ta feuille concernée et colle ce code dans les propriétés de la feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Calculate
End Sub

Re,

Tu peux également mettre le code dans les propriétés d'un bouton ACTIVEX qui se trouve dans les propriétés feuille ce qui donne

Private Sub CommandButton1_Click()
Dim i As Integer
[A1].Select
x = Range("A65536").End(xlUp).Row
For i = 2 To x Step 2
Union(Selection, Range("A" & i, "B" & i)).Interior.ColorIndex = 3
Next i
[A1].Interior.ColorIndex = xlNone
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Calculate
End Sub

et la mise en forme conditionnelle avec le surlignage cette fois vert, si le tableau est important il faudra passer avec un code VBA

https://www.cjoint.com/c/CADotjGgiIf

Re,

Je m'absente un moment, supprime la mise en forme conditionnelle et ce code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Calculate
End Sub

dès que je rentre je t'adapte un code écrit par Boisgontier, un Maître parmis les Maîtres

Salut,

Regardes si c'est ce que tu cherches

Sub Selection_1_sur_X()
Dim i As Integer
x = Range("A65536").End(xlUp).Row
For i = 2 To x Step 2
Union(Selection, Range("A" & i, "C" & i)).Interior.ColorIndex = 3
Next i
End Sub

Bien sur les colonnes comme la couleur peuvent changer

Salut Mike-31, Salut Forum

Merci pour ta réponse, ton code fonctionne comme voulu

mais un petit bémole toutefois

Si par exemple le curseur est en colonne E5 et que j'exécute le code cette cellule se
colorie aussi

J'ai donc fait fait un autre essai j'ai sélectionné la plage E5:F10 par Ex:

Le code a bien fonctionné cela m'a bien colorier une ligne sur deux de la colonne A et de la colonne B

PLUS la plage que j'ai sélectionné, je n'ai pas trouvé comment palier a ce soucis

je vais vite me retrouver avec des cellules colorisées un peu partout

Merci beaucoup pour ton aide je te souhaite une bonne journée

a te relire avec plaisir

Cordialement Ray

Re,

Tu peux rajouter en début de code la sélection de ta première cellule à coloriser
[A2].Select
comme ceci

Sub Selection_1_sur_X()
Dim i As Integer
[A2].Select
x = Range("A65536").End(xlUp).Row
For i = 2 To x Step 2
Union(Selection, Range("A" & i, "C" & i)).Interior.ColorIndex = 3
Next i
End Sub

si l'adresse de ta première cellule à coloriser est variable il est possible de créer un boucle ou aller la chercher ce qui allongera le code, mais le code ci dessus devrait le faire
A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Re Salut Mike

Merci pour ta réponse bien matinal, j'ai suivi ton conseil j'ai mis [C1].select et tout fonctionne bien, j'ai juste donc plus que la cellule C1 qui se colore.

Si svp tu a le temps et si possible pourrai tu me faire un petit code qui ferai monter et descendre une barre de couleur unique pour mes colonnes A et B

ce n'ai pas pressé, merci a toi déja pour l'aide apporter, bonne journée a toi

Un petit café pour secouer les neurones et c'est parti pour la journée

Bye bye merci Mike

Cordialement Ray

Salut Mike

Merci pour la réponse, c'est bon ca marche bien comme je souhaitai

j'ai du me gourrer quelque part, donc ok pour moi.

Pourrai t'on svp remplacer par un petit code qui ferai monter et descendre une barre de couleur unique pour me déplacer dans mes colonnes A et B.

Merci a plus tard

Raymond

Re Mike

Bon dans ma première idée était de faire coloriser une ligne sur deux

c'est chose faites grace a toi, merci

mais comme ma liste est longue, il est plus aisé de déplacer une barre de couleur

avec la molette de la souris ou les flèches de déplacement du clavier dans les colonnes A et B comme pour faire une sélection, mais la pas besoin de sélection

Juste une barre qui monte et descends le long de ma liste pour une meilleure utilisation et de repérage dans le listing

Si tu a le temps bien sur

A plus tard et merci

Ray

Re Mike

Merci de t'interesser a mon programme, c'est beaucoup sympa ihihhi

j'ai fait quelques essais mais ca n'a pas l'air de fonctionner

alors je te mets tout le code, ca sera plus simple comme ca, j'espere pouvoir éclairer un peu plus ta lanterne quand a ce que je souhaite faire svp.

j'ai un bouton dans la feuill1 pour lancer la première macro (RepertorierVideos)
qui a pour but d'afficher la liste des vidéos se trouvant sur mon disc dur E.

j'ai un autre bouton (RepertorierAffiches) dans la feuill1 pour lancer ensuite la récupération de la liste des affiches idem disc dur E

plus appel de ta macro

PS je n'ai pas d'autres codes dans le projet que celui ci dessous

le but: de ce programme

colonne A liste des vidéos Ex Tintin.avi
colonne B liste des affiches corespondantes aux vidéos Ex Tintin.jpg

donc je recupére ces listes dans disk E

et je souhaite svp par une barre qui monte ou descends vérifier si le nom de la vidéo en (A) corresponds bien au nom de l'affiche en (B), voir si pas de manquante etc etc

Avec beaucoup de merci Mike

bonne après midi

Option Explicit

Sub RepertorierVideos()
  Dim Chemin As String, Fichier As String, Numligne As Long
  Range("A:B") = ""
  Range("A:B").Interior.ColorIndex = xlNone
  [C1].Select
  'indique le répertoire contenant les fichiers
  Chemin = "E:\VIDEOS\"
  'Boucle sur tous les fichiers .avi du répertoire
  Fichier = Dir(Chemin & "*.avi")
  Numligne = 1
  Do While Len(Fichier) > 0
    Sheets("Feuil1").Range("A" & Numligne).Value = Fichier
    Numligne = Numligne + 1
    Fichier = Dir()
  Loop
End Sub


Sub RepertorierAffiches()
  Dim Chemin As String, Fichier As String, Numligne As Long
  Chemin = "E:\AFFICHE\"
  Fichier = Dir(Chemin & "*.jpg")
  Numligne = 1
  Do While Len(Fichier) > 0
    If Fichier <> "Liberty.jpg" Then
      Sheets("Feuil1").Range("B" & Numligne).Value = Fichier
      Numligne = Numligne + 1
    End If
    Fichier = Dir()
  Loop
  Call Selection_1_sur_X
End Sub

Sub Selection_1_sur_X()
  [A1].Interior.ColorIndex = xlNone
  Dim i As Integer, x As Long
  [A1].Select
  x = Range("A65536").End(xlUp).Row
  For i = 2 To x Step 2
    Union(Selection, Range("A" & i, "B" & i)).Interior.ColorIndex = 4
  Next i
  [A1].Interior.ColorIndex = xlNone
End Sub

les 3 lignes de codes ci-dessous sont comme tu m'a dit dans la feuill1

'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Target.Calculate
'End Sub

Re Mike

merci j'ai recu et essayer le fichier envoyer sur cjoint

c'est bien comme ca que je souhaiterai que ca marche

je préfère passer par VBA je comprends mieux

Donc que doit-je faire maintenant svp

A plus tard

Ok Mike merci c'est gentil a toi

a plus tard rien ne presse t'inquiéte pas

Bye bonne apres midi

Raymond

Re,

Voila le fichier, tous les codes sont dans la propriété feuille, la détection de la plage de donnée est automatique en fonction de la dernière cellule non vide de la colonne A
la surlignage couvre les cellules de A à C si tu veux limiter à B il n'y a pas de problème

https://www.cjoint.com/c/CADpWrADU9v

Salut Mike
je n'arrive plus a te repondre des que j'envoi le réponse j'ai ce message

*Veuillez écrire correctement s'il vous plaît (pas de SMS, orthographe, grammaire)

Re,

Ah bon bizarre

rééssaye voir

Mike

Bien recu ton fichier merci beaucoup j'ai adapter a mon programme et ca fonctionne parfaitement bien, je repere tres bien les lignes de mon listing

j'ose encore abuser de ta gentillesse mais pour en finir avec ce codependant que tu l'a en tete.

te serai t'il possible de rajouter un test pour verifier si le contenu de la colonne (A)
correspond bien a celui de la colonne (B)

en tenant compte que la colonne (A) ne sont que des fichiers .avi et colonne (B) que des .jpg les extentions avi et jpg sont toujours ecrites en minuscules

donc si le test n'ai pas bon afficher en face colonne (C) un message en rouge "erreur" par exemple

je te remercie encore une fois pour ton excellent travail et j'apprecie ton aide

a plus tard Mike

Raymond

Re,

es ce important de tester les extensions des deux colonnes ou simplement si les cellules de ces deux colonnes sur la même ligne sont renseignées exemple A5 et B5 alors en C5 vide ou erreur si une cellule est vide.

Pourquoi veux tu utiliser un code VBA tu as la mise en forme conditionnelle qui le fait très bien

Re,

Crée un nouveau bouton ACTIVEX et colle ce code dans ses propriétés

Private Sub CommandButton2_Click()
For L = 2 To [A65536].End(xlUp).Row ' Application de la ligne 2 à la dernière ligne non vide
Mot1Mot2 = Cells(L, "A")
I = InStr(Mot1Mot2, ".avi") ' recherche le point commun entre les mots colonne A
For M = 2 To [B65536].End(xlUp).Row ' Application de la ligne 2 à la dernière ligne non vide
Mot1Mot2 = Cells(M, "B")
y = InStr(Mot1Mot2, ".jpg") ' recherche le point commun entre les mots colonne B
If I = 0 And y = 0 Then
Cells(M, "C") = "Erreur"
Cells(M, "C").Font.ColorIndex = 3
ElseIf I <> 0 And y <> 0 Then
Cells(M, "C") = ""
Cells(M, "C").Font.ColorIndex = xlAutomatic
End If
Next
Next
End Sub