XL 2019 lien hypertxte

[litchoutsou]

Salut à tous et bon week end, vous m'aviez dèjà aidé pour touvez cette formule et je vous en remerci , avant range était A1, N1, parce que la présentation de mes données était a l'horizontale, j'ai dù modifieé et mettre ma presentation en verticale, range devien A1, A14? A27 ect...... losque je fait le lien hypertexte a partie d'une autre feuille A1 se met en jaune, Mais pas A14 ni les autres.
Il doit y avoir un texte qui est faut ; voici la formule


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A1,A14,A27,A40,A53,A66,A79")) Is Nothing Then
Cells.FormatConditions.Delete
Rows("1:1").FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=""" & Target.Value & """"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End If

[M250] = ""

End Sub

 

[Staple1600]

Bonjour le fil

Sauf erreur ceci
Rows("1:1").
ne concerne que la ligne 1
Donc c'est normal que cela fonctionne ^pour A1 mais pas pour A14 ou en général tout ce qui ne se trouve pas sur la ligne 1

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @litchoutsou
Essai cela :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     Dim MyRange As Range
     With Me
          Set MyRange = Union(.[A1], .[A14], .[A27], .[A40], .[A53], .[A66], .[A79])
     End With
     If Not Intersect(Target, MyRange) Is Nothing Then
          With MyRange.FormatConditions
               .Delete
               Set Fc = .Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""" & Target.Value & """")
               Fc.Interior.Color = 65535
          End With
     End If
End Sub

A bientôt

Edit : Remarque que la MFC n'est pas mise à jour quand on selectionne une cellule extérieure à MyRange (et donc peut rester jaune)

Edit2 : pour tenir compte des valeurs numériques ou textes de Target :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     Dim MyRange As Range
     With Me
          Set MyRange = Union(.[A1], .[A14], .[A27], .[A40], .[A53], .[A66], .[A79])
     End With
     If Not Intersect(Target, MyRange) Is Nothing Then
          With MyRange.FormatConditions
               .Delete
               If IsNumeric(Target.Value) Then txt = Target.Value Else txt = """" & Target.Value & """"
               Set Fc = .Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=" & txt)
               Fc.Interior.Color = 65535
          End With
     End If
End Sub

 

[litchoutsou]

Super ça fonctionne bien merci pour ton aide même un jour férier, tu as le droit à des doubles remerciement