Sélection et remplissage cellule

Le 15/07/2020 à 12:27

Bonjour à tous,

Je souhaiterais sélectionner une cellule en fonction de sa valeur interne et mettre d'une certaine couleur le fond de cette cellule .

J'ai écrit ce code mais il ne se passe rien et je ne sais pas trop d'où cela peut venir.

Option Explicit

Sub ColorierCode()

Dim code As String
Dim couleur As String
Dim VERT As String
Dim VERTCLAIR As String
Dim JAUNE As String
Dim BLEU As String
Dim r As Range

code = InputBox("Entrer le code du composant", "code")
couleur = InputBox("Entrer la couleur du composant", "coleur")

Set r = ActiveSheet.Cells.Find("code", , xlValues, xlWhole)
If Not r Is Nothing Then r.Select

Select Case code
    Case Is = VERT: Range("r").Interior.ColorIndex = 10
    Case Is = VERTCLAIR: Range("r").Interior.ColorIndex = 43
    Case Is = JAUNE: Range("r").Interior.ColorIndex = 27
    Case Is = BLEU: Range("r").Interior.ColorIndex = 33

End Select

End Sub

Merci d'avance, bonne journée.

Le 15/07/2020 à 13:23

Salut,

Je pense que ton code contient plusieurs erreurs. Mais sans avoir ton fichier à disposition, on est un peu dans le cirage. Tu as entre autre mis des variables entre guillement, ce qui en fait du texte.

Je te montre une solution bricolée en vitesse où j'ai utilisé des If/ElseIf/EndIf à la place de tes Select.

Amicalement.

6essai-pedro.xlsm (22.77 Ko)
Le 15/07/2020 à 13:37

Bonjour, salut Yvouille !

Un essai à chaud :

Option Explicit
Sub ColorierCode()

Dim code As String
Dim couleur As Integer
Dim r As Range

Début:
code = InputBox("Entrer le code du composant", "code")
couleur = Application.InputBox("Entrer le n° correspondant à la couleur du composant", "couleur", "1 = vert, 2 = vert clair, 3 = Jaune, 4 = bleu", Type:=1)
Set r = ActiveSheet.Cells.Find(code, , xlValues, xlWhole)
If Not r Is Nothing Then
    Select Case couleur
        Case 1: r.Interior.ColorIndex = 10
        Case 2: r.Interior.ColorIndex = 43
        Case 3: r.Interior.ColorIndex = 27
        Case 4: r.Interior.ColorIndex = 33
        Case Else: MsgBox "Couleur non reconnue !"
    End Select
Else
    If MsgBox("Le code '" & code & "' n'a pas été retrouvé dans la feuille. Recommencer ?", vbYesNo, "Erreur code") = vbYes Then GoTo Début
End If

End Sub

Comme indiqué par Yvouille, les guillemets délimitent du texte... Les variables String avec des noms de couleurs sont toutes vides car non initialisées, c'est plutôt à ce niveau que tu aurais pu utiliser des guillemets pour définir des couleurs sous forme de texte. A noter que les Is = sont inutiles dans Select Case car plutôt utilisés pour des comparaisons numériques (>, >=, etc).

Le 15/07/2020 à 14:27

Merci Yvouille,

Merci, je début dans le VBA et j'ai pas mal d'erreurs. Le code est top mais il n'y a que la première cellule qui est remplie... comment faire pour quelles le soient toutes ?

Le 15/07/2020 à 14:30

Merci Pedro22

Mais que faut-il taper pour les couleurs parce qu'a chaque fois ça me dis que la couleurs non reconnue.

Le 15/07/2020 à 14:34
Pedroperzival a écrit :

Merci Pedro22

Mais que faut-il taper pour les couleurs parce qu'a chaque fois ça me dis que la couleurs non reconnue.

Normalement la saisie n'est autorisée que pour des nombres, j'ai d'ailleurs indiqué la correspondance entre les n° à saisir et les couleurs (de 1 à 4).
Cette partie peut-être améliorée par le biais d'un Userform, plus adapté que l'Inputbox.

Par exemple, par le biais de la fonction ColorBox proposée par Sébastien.

Le 15/07/2020 à 14:43

Normalement la saisie n'est autorisée que pour des nombres, j'ai d'ailleurs indiqué la correspondance entre les n° à saisir et les couleurs (de 1 à 4).

Cette partie peut-être améliorée par le biais d'un Userform, plus adapté que l'Inputbox.

Par exemple, par le biais de la fonction ColorBox proposée par Sébastien.

Justement que je mette n'importe quel chiffre j'ai systématiquement Couleur non reconnue

Le 15/07/2020 à 14:46
Pedroperzival a écrit :

Justement que je mette n'importe quel chiffre j'ai systématiquement Couleur non reconnue

J'ai fait le test tout à l'heure sans problèmes... Peux tu poster ton fichier test sur lequel le soucis se présente ?

Le 15/07/2020 à 14:53

Voici le type de fichier sur lequel je suis amené a travailler

4remplir.xlsm (15.39 Ko)
Le 15/07/2020 à 15:15
Pedroperzival a écrit :

Voici le type de fichier sur lequel je suis amené a travailler

4remplir.xlsm (15.39 Ko)

Une erreur d'inattention de ma part : Select Case code est à remplacer par Select Case couleur

Je modifie le code de mon 1er post pour corriger l'erreur.

Le 15/07/2020 à 16:03

C'est bon le code est fonctionnel cependant il ne rempli que la première cellule comment faire une commande pour qu'il s'exécute sur toutes les cellules ?

Le 15/07/2020 à 16:11
Pedroperzival a écrit :

C'est bon le code est fonctionnel cependant il ne rempli que la première cellule comment faire une commande pour qu'il s'exécute sur toutes les cellules ?

Question bête : y'a-t-il un intérêt particulier à réinventer la roue via VBA, plutôt que d'utiliser directement une MFC ?

Concernant ta demande, tu peux substituer ton instruction find par une boucle. Un essai :

Option Explicit
Sub ColorierCode()

Dim code As String, couleur As Integer, r As Range, Trouvé As Boolean

Début:
code = InputBox("Entrer le code du composant", "code")
couleur = Application.InputBox("Entrer le n° correspondant à la couleur du composant", "couleur", "1 = vert, 2 = vert clair, 3 = Jaune, 4 = bleu", Type:=1)
If Not (couleur >= 1 And couleur <= 4) Then
    MsgBox "Couleur non reconnue !"
    couleur = 1
End If
For Each r In ActiveSheet.Range("A1").CurrentRegion
    If r.Value = code Then
        Trouvé = True
        Select Case couleur
            Case 1: r.Interior.ColorIndex = 10
            Case 2: r.Interior.ColorIndex = 43
            Case 3: r.Interior.ColorIndex = 27
            Case 4: r.Interior.ColorIndex = 33
        End Select
    End If
Next r
If Not Trouvé Then
    If MsgBox("Le code '" & code & "' n'a pas été retrouvé dans la feuille. Recommencer ?", vbYesNo, "Erreur code") = vbYes Then GoTo Début
End If

End Sub
Le 15/07/2020 à 16:19

Merci c'est exactement ce que voulais faire.

Je ne connaissais pas la MFC, j'aurais pu l'utiliser mais merci en tout cas.

Le 15/07/2020 à 16:22
Pedroperzival a écrit :

Merci c'est exactement ce que voulais faire.

Je ne connaissais pas la MFC, j'aurais pu l'utiliser mais merci en tout cas.

Je pense que la MFC sera plus simple à mettre en œuvre et maintenir dans le temps, par contre la couleur est prédéterminée.
Merci du retour, pense à indiquer que le problème est résolu.

A+

Rechercher des sujets similaires à "selection remplissage"