Souligner automatiquement si 2 conditions sont remplies

Bonjour

A première vue pas de solution

sans trop de conviction

Mets un MsgBox "Ici" dans la procédure Private Sub Worksheet_Change(ByVal Target As Range) de la feuille "A FAIRE" pour savoir si elle est appelée

A suivre

Merci pour ta réponse.

J'ai suivi tes consignes, et la boîte de dialogue apparait bien.

Bizarrement, l'ancienne version du code fonctionne encore, mais pas celle que tu as postée pour dépasser la limitation à 1030 caractères (elle a marché parfaitement jusqu'à ces derniers jours). Si ça peut te donner une idée de ce qui coince, je colle ces 2 bouts de code.

Merci.

Ancienne version :

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = Range("ad16").Address Then
    Recherche (Target.Text)
    Exit Sub
  End If

Dim Pos1 As Integer
Dim Pos2 As Integer

  If Target.Address = Range("C6").Address Then
    Recherche (Target.Text)
  ElseIf Not Intersect(Range("h9:h" & Range("h65536").End(xlUp).Row), Target) Is Nothing Then
    With Cells(Target.Row, 8)
      Pos1 = 0
      Pos2 = 0
      Do
        Pos1 = InStr(Pos1 + 1, .Text, "–")
        If Pos1 > 0 Then
          Pos2 = InStr(Pos1, .Text, ":")
          If Pos2 > 0 Then
            .Characters(Start:=Pos1 + 2, Length:=Pos2 - (Pos1 + 1)).Font.Underline = xlUnderlineStyleSingle
          End If
        End If
      Loop Until Pos1 = 0
    End With
  End If
End Sub

Version pour dépasser la limite à 1030 caractères :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Pos1
Dim Pos2

  Pos1 = 0

  If Not Intersect(Range("AD16,C6"), Target) Is Nothing Then
    Recherche (Target.Text)
  ElseIf Not Intersect(Range("H9:H" & Range("H65536").End(xlUp).Row), Target) Is Nothing Then
    With Target
      .Font.Size = 7
      Do
      Pos1 = Evaluate("=FIND(""–""," & Target.Address & "," & (Pos1 + 1) & ")")
        If IsError(Pos1) Then Exit Do
        Pos2 = Evaluate("=FIND("":""," & Target.Address & "," & Pos1 & ")")
        If IsError(Pos2) Then Exit Do
        .Characters(Start:=Pos1 + 2, Length:=Pos2 - (Pos1 + 1)).Font.Underline = xlUnderlineStyleSingle
      Loop
    End With
  End If
End Sub

...à moins que le problème vienne du code dans le module (mais qui a priori n'a pas changé) :

Sub Format_Souligne_Auto_si_tiret_2_points()
'Macro qui souligne tout texte entre un tiret demi-cadratin "–" et 2 points ":"
'Static Old_Quoi As String

Dim I As Integer
Dim Pos1 As Integer
Dim Pos2 As Integer
Dim Lg_Der As Long
Dim Lg_Deb As Long
Dim Souligne As Integer

  Application.ScreenUpdating = False

  With ActiveSheet.Shapes(Application.Caller).TextFrame.Characters
    If .Text = "Souligne" & vbLf & "OUI" Then
      Souligne = xlUnderlineStyleSingle
      .Text = "Souligne" & vbLf & "NON"
    Else
      Souligne = xlUnderlineStyleNone
      .Text = "Souligne" & vbLf & "OUI"
    End If
  End With

  Lg_Deb = 9
  Lg_Der = Range("H65536").End(xlUp).Row
  For I = Lg_Deb To Lg_Der
    Pos1 = 0
    Pos2 = 0
    Do
      Pos1 = InStr(Pos1 + 1, Cells(I, 8), "-")
      If Pos1 > 0 Then
        Pos2 = InStr(Pos1, Cells(I, 8), ":")
        If Pos2 > 0 Then
          With Cells(I, 5).Characters(Start:=Pos1 + 2, Length:=Pos2 - (Pos1 + 2)).Font
            .Underline = Souligne
          End With
        End If
      End If
    Loop Until Pos1 = 0
  Next I
End Sub

Bonjour

Comme avec le fichier que j'ai je n'ai pas de soucis

Cela ne fonctionne plus

Quoi exactement ?

essayes avec un texte court pour savoir si cela fonctionne

A suivre

Une autre piste le signe de départ n'est pas le signe - (moins) (code 45) mais le signe demi-cadratin (code 150)

A voir

Merci pour ta réponse.

L'ancienne version du code marche comme avant (donc avec la limitation à 1030 caractères).

La nouvelle n'agit plus, même sur des textes courts.

J'ai bien vérifié : mes tirets sont bien des tirets demi-cadratins...

Mystère et boule de gomme...?!

-- Jeu Mar 31, 2011 2:38 pm --

...à force de bidouiller, j'ai collé pour la nième fois le code de ton message du 15 mars (à 3h04 du matin !), et ça remarche !!!

Va comprendre...

En tous cas je suis content, ça remarche.

Jusqu'à un prochain bug ?