Text en filigrane

[enzo_s]

Bonjour à tous,

J'essaye d'ajouter du text en filigrane dans une cellule qui s'efface quand je sais une valeur.

Le but est de mettre un exemple en filigrane qui c'efface quand on complet la cellule

Encore merci !!

 

[job75]

Bonjour enzo_s,

Voyez le fichier joint avec la Mise en forme conditionnelle (MFC) sur les colonnes C:E.

A+

 

[pierrejean]

Bonjour Enzo
un essai un tantinet capillotracté
2 macros
prepare : apres lancement on ecrit dans les cellules concernées avec Couleur de Font gris plus ou moins fonçé
fonctionne: apres lancement la selection d'une de ces cellules reviendra en Font automatique et à vide

 

[enzo_s]

Merci pour vos réponse,
Avec le premier exemple de Job75 je suis embêté parce que j'utilise une macro qui supprime Contents et du coup aussi la MFC
Dans l'exemple de Pierre Jean, je le même problème. Il faudrait que quand la cellule est vide elle présente son texte en filigrane mais une fois remplie disparaît mais revient ci je clean la cellule.
C'EST une peu tiré par les cheveux
Merci encore

 

[frangy]

Bonjour à tous,

Un autre essai :

 

[enzo_s]

Est-il possible de l'adapter pour que plutôt d'avoir une plage de cellule A1:A10

Je choisisse exemple :

B2=CHVSGRI
B3=Campus de Bla bla
G15=NCHCHTTF12
Etc

Thanks pour l'aide


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
Application.EnableEvents = False
With Target
If .Value = "CHVSHRI" Or .Value = "" Then
.Value = "CHVSHRI"
.Font.ColorIndex = 15
Else
.Font.ColorIndex = 1
End If
End With
Application.EnableEvents = True
End If
End Sub

 

[frangy]

L'évènement Worksheet.Change est déclenché lorsque le contenu d'une cellule est modifiée dans la feuille.
Pour traiter des cellules spécifiques, il faut donc pouvoir "cibler" ces cellules.
La question est donc de savoir comment l'emplacement de ces cellules est défini (adresse, nom de cellule, recherche préalable, etc. ) .
Avec un exemple concret et explicite, tu auras plus de chance d'obtenir une réponse adaptée.

 

[job75]

Re, salut Pierre, frangy,

Est-il possible de l'adapter pour que plutôt d'avoir une plage de cellule A1:A10

Je choisisse exemple :

B2=CHVSGRI
B3=Campus de Bla bla
G15=NCHCHTTF12
Etc

Ceci va bien :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, b, i
a = Array("B2", "B3", "G15") 'à adapter
b = Array("CHVSGRI", "Campus de Bla bla", "NCHCHTTF12") 'à adapter
For i = 0 To UBound(a)
    If Range(a(i)) = "" Then
        Range(a(i)).Font.ColorIndex = 16
        Range(a(i)).Font.Bold = False 'non gras
        Range(a(i)) = b(i)
    ElseIf Range(a(i)) <> b(i) Then
        Range(a(i)).Font.ColorIndex = xlAutomatic
        Range(a(i)).Font.Bold = True 'gras, facultatif
    End If
Next
End Sub

A+

 

[enzo_s]

Salut Job75

Merci pour le script ça fonctionne bien mais j'ai un petit souci :
- dans le cas ou j'ai des virgule, il les remplace par ' exemple = "100,200,300", "100"

Comment contourner le souci ?

Merci !

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, b, i
a = Array("C11", "C12", "F24") 'à adapter
b = Array("CHVSGRI", "100,200,300", "100") 'à adapter
For i = 0 To UBound(a)
    If Range(a(i)) = "" Then
        Range(a(i)).Font.ColorIndex = 18
        Range(a(i)).Font.Bold = False 'non gras
       Range(a(i)) = b(i)
    ElseIf Range(a(i)) <> b(i) Then
        Range(a(i)).Font.ColorIndex = 18
        Range(a(i)).Font.Bold = False 'gras, facultatif
    End If
Next
End Sub

 

[pierrejean]

Re

A tester:
b = Array("CHVSGRI", "100" & "," & "200" & "," & "300", "100") 'à adapter

 

[enzo_s]

Non ça ne fonctionne pas,

la réponse est

100'200'300

 

[job75]

Bonjour enzo_s, Pierre, frangy,

exemple = "100,200,300", "100"

En VBA la virgule est le séparateur des milliers, pour l'éviter utiliser le format Texte :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, b, i
a = Array("C11", "C12", "F24") 'à adapter
b = Array("CHVSGRI", "100,200,300", "100") 'à adapter
For i = 0 To UBound(a)
    If Range(a(i)) = "" Then
        Range(a(i)).NumberFormat = "@" 'format Texte
        Range(a(i)).Font.ColorIndex = 18
        Range(a(i)).Font.Bold = False 'non gras
       Range(a(i)) = b(i)
    ElseIf Range(a(i)) <> b(i) Then
        Range(a(i)).NumberFormat = "General" 'format Standard
        Range(a(i)).Font.ColorIndex = Automatic
        Range(a(i)).Font.Bold = False 'gras, facultatif
    End If
Next
End Sub

A+

 

[job75]

Une autre solution (meilleure) est de remplacer la virgule "normale" (code 44) par la virgule "spéciale" (code 130) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, b, i
a = Array("C11", "C12", "F24") 'à adapter
b = Array("CHVSGRI", "100,200,300", "100") 'à adapter
For i = 0 To UBound(a)
    b(i) = Replace(b(i), ",", Chr(130))
    If Range(a(i)) = "" Then
        Range(a(i)).Font.ColorIndex = 18
        Range(a(i)).Font.Bold = False 'non gras
        Range(a(i)) = b(i)
    ElseIf Range(a(i)) <> b(i) Then
        Range(a(i)).Font.ColorIndex = Automatic
        Range(a(i)).Font.Bold = False 'gras, facultatif
    End If
Next
End Sub

 

[enzo_s]

Génial ça fonctionne

Merci