XL2010 Modif code pour texte et couleur cellule

Bonjour à tous

Sur le site j'ai récupéré et adapté ce code

 'PROCEDURE METTRE OU EFFACER TEXTE "CLOT" DS FEUILLE "DataBase"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

 Dim Cel As Range
 If Not Intersect(Target, Range("l5:L1048455")) Is Nothing Then

    If Target.Interior.Color = RGB(146, 208, 80) Then
        Target.Value = ""
        Target.Interior.Color = xlNone

     Else

        Target.Interior.Color = RGB(146, 208, 80)
            With Selection
                .Font.ColorIndex = 2
                .Value = "CLOT"
                .Font.Size = 12
                .Font.FontStyle = "Gras"

            End With

    End If
  End If
  Cancel = True
End Sub

Ma demande serait de pouvoir si cela est possible:

1- Si je met CL dans la cellule que j'ai sélectionné -> j'ai la cellule qui met CLOT avec Font.ColorIndex = 2

2- Si je met RE dans la cellule que j'ai sélectionné -> j'ai la cellule qui met Reporté avec Font.ColorIndex = 45

3- je vais surement utiliser 2 ou 3 autres mots clés

Vous allez me dire que si au moins une fois j'ai inscrit CLOT ou Reporté je vais le retrouvé automatiquement, mais pas la couleur je pense.

Merci de votre aide

Ledzep

Bonjour,

à tester,

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("l5:L1048455")) Is Nothing Then

    If Target.Value = "CL" Then
        Target.Value = "CLOT"
        Target.Font.ColorIndex = 2
    ElseIf Target.Value = "RE" Then
        Target.Value = "Reporté"
        Target.Font.ColorIndex = 45
    Else
        Target.Font.ColorIndex = xlNone
    End If
End If    
Application.EnableEvents = True
End Sub

Bonjour à tous,

Autre proposition où tu définis tes remplacements dans une feuille Param :

Tu peux ajouter autant de mots-clés que tu veux. Rien mettre en dessous

Macro unique pour toutes les feuilles, dans ThisWorkbook. Seules les cellules sans formule sont traitées.

eric

Bonjour à tous

Merci de vos réponses

Je teste ce week-end vos propositions et adapte à mon projet

Merci de votre retour

Bonne journée

Ledzep

Bonjour,

je reconnais mon code, tu es donc déjà sur la 2ème proposition.

L'idée est d'avoir un code qu'on ne touche pas (sauf si tu veux lui ajouter ou enlever des fonctionnalités). On se contente de saisir mot clé, plage d'action, et la saisie de remplacement avec son format dans la feuille Param.

Des commentaires ? Précise quelle ligne tu ne comprends pas après avoir fait F1 sur les fonctions ou propriétés que tu ne connais pas.

C'est souvent auto-documenté : HorizontalAlignment c'est alignement horizontal par exemple.

Le principe : pour chaque cellule d'une plage modifiée je regarde si c'est un des mot-clé définis dans Param!Ax, et si elle appartient à la plage définie dans Param!Bx.

Si oui je copie valeur et formats de Param!Cx pour mettre dans la cellule en cours de traitement

eric

Bonsoir à tous

Eric

Ton code fonctionne sur ton fichier, je vais le mettre ds le mien, j'avais une feuille nommée administrateur avec les cellules déjà occupée , c'est pour cela que je te demandais une explication sur ton code.

je vais crée la feuille param en plus

Voila

I20100

J'ai essayé ton code, hélas il ne fonctionne pas j'ai ajouté ,un end if qu'il manquait.

Par contre je ne comprends pas pourquoi il fonctionne un coup sur trois ou deux .

Je vais poursuivre mes recherches

Trop fatigué ce soir

Je suis un novice , donc j'appends ..

Merci de votre aide et aussi de m'avoir répondu la première fois.

Ledzep

Bonjour,

si la cellule est occupée il faut revalider le mot clé si tu veux que la macro entre en action.

eric

Bonjour à tous

Eriiic

J'ai essayé ta méthode mais je n'y arrive pas le faire sur 'Mot-Clé' je m'en excuse

J'ai mis une partie de mon fichier avec les paramètres de ton fichiers que je me suis permis d'adapter.

Mais pas encore en totalité conforme à mon souhait.

Pouvez vous regarder svp, l'explication est dans les commentaires.

Je n'ai pour autant pas abandonnée la proposition de I20100, mais je ne parviens pas à faire ce que je désire avec, mais je travaille dessus

Ds les 2 cas ma formation se complète

Merci de votre aide

Bonne journée à tous

Ledzep

Bonjour,

pour simplifier j'ai mis les paramètres en Tableau nommé T_MotsCles

Comme ça tu peux le glisser ou le couper-coller où tu veux.

J'ai ajouté aussi l'acceptation du mot clé complet. Si tu saisis "d", excel pré-remplit et propose Défaut, que tu peux donc valider directement maintenant.

Le code adapté :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim datas, pl As Range, c As Range, c2 As Range, i As Long, tmp
    datas = [T_MotsCles].Value
    For i = 1 To UBound(datas)
        tmp = Split(Replace(datas(i, 2), "=", "!"), "!")    ' ref Plage de cellules impactées
        On Error GoTo suite
        Set pl = Intersect(Target, Sheets(tmp(1)).Range(tmp(2)))
        On Error GoTo -1
        If Not pl Is Nothing Then
            For Each c In pl ' pour chaque cellule modifiée
                If Not c.HasFormula Then
                    If LCase(Target.Formula) = LCase(datas(i, 1)) Or LCase(Target.Formula) = LCase(datas(i, 3)) Then
                        Set c2 = [T_MotsCles].Cells(i, 3)    ' cell des formats
                        Application.EnableEvents = False
                        Target = c2.Value    ' nouvelle valeur
                        Application.EnableEvents = True
                        With c2
                            c.Interior.Color = IIf(.Interior.Color = 16777215, xlNone, .Interior.Color)
                            With .Font
                                c.Font.Name = .Name
                                c.Font.Size = .Size
                                c.Font.Color = .Color
                                c.Font.FontStyle = .FontStyle
                            End With
                            c.HorizontalAlignment = .HorizontalAlignment
                            c.VerticalAlignment = .VerticalAlignment
                            c.IndentLevel = .IndentLevel
                        End With
                        Exit For
                    End If
                End If
            Next c
        End If
suite:
        On Error GoTo -1
    Next i
End Sub

Si tu pouvais éditer ton post de 19:41 pour supprimer le code stp.

Tu as commencé des modifs (erronées) et ça risque d'induire en erreur d'éventuels lecteurs.

eric

Bonjour à tous

suis sur mon téléphone

OK je vais supprimer ce code.

merci pour ta réponse.

je vais pouvoir decripter ce code.

Merci à vous et serai de retour demain soir

Bonne après midi à vous

Ledzep

Bonsoir à tous

Bonsoir Eriiic

Merci de ton aide, c top ton programme, je l'ai essayé depuis ton fichier cela fonctionne très bien.

je suis à des années lumière de tes connaissances

Si tu pouvais éditer ton post de 19:41 pour supprimer le code stp.

Tu as commencé des modifs (erronées) et ça risque d'induire en erreur d'éventuels lecteurs.

eric

Je n'ai pas trouvé le moyen de le supprimer, donc j'ai "rapporter" le message pour suppression, j'espère que c'est comme cela qu'il faut faire !

J'aime ta citation

En essayant continuellement, on finit par réussir.

Donc plus ça rate, plus on a de chances que ça marche.(les Shadoks)

En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci

Encore Merci de ton aide.

Bonne soirée

Ledzep

Bonjour,

donc j'ai "rapporter" le message pour suppression

Ce n'était pas nécessaire d'aller jusque là

Ce n'est pas critique non plus

Bonne continuation

eric