Changer le texte en lien

Bonjour tout le monde
Je souhaite modifier le code dont la fonction est de changer le texte en lien Google puis change sous le nom " url-location"
Le problème est que chaque fois que j ajoute de nouvelles lignes, tout l'ancien travail change son statut de lien Google à lien interne.
Résume : Si de nouvelles lignes sont ajoutées et que je souhaite les modifier, l'ancien lien ne sera pas modifié ou changer son etat
Merci

Sub HyperlinkConverter()
Dim rng As Range
    Dim cell As Range

   For Each xCell In Range("E22:E10000")
      If xCell.Value <> "" Then
         ActiveSheet.Hyperlinks.Add Anchor:=xCell, Address:=xCell.Formula
      End If
   Next xCell
   Set rng = Range("E22:E10000") 'change this to your desired range

    For Each cell In rng.Cells
        If cell.Hyperlinks.Count > 0 Then
            cell.Value = "URL-LOCATIION"
        End If
    Next cell

End Sub

Bonjour,

cell.Value = "URL-LOCATIION"

Est-ce normale cette erreur de saisie ? Deux i

Bonjour,

Essayez plutôt ceci, en vérifiant que la cellule ne contient pas déjà un lien avant de le modifier.

Sub HyperlinkConverter()
  Dim xCell As Range

  For Each xCell In Range("E22:E10000")
    If xCell.Value <> "" And xCell.Hyperlinks.Count = 0 Then
      ActiveSheet.Hyperlinks.Add _
        Anchor:=xCell, _
        Address:=xCell.Value2, _
        TextToDisplay:="URL-LOCATION"
    End If
  Next xCell
End Sub

Merci beaucoup, saboh12617 c'est ce que j'attendais
petite question Comment puis-je vérifier et ajouter un code si le lien est correct ou non ?
Autrement dit, si le lien commence par : https:// c'est un lien valide. Sinon, le lien est coloré en rouge, par exemple.
merci

Bonjour,

Je pense que l'adaptation ci-dessous devrait convenir. Dans l'ordre :

Si elle contient un lien : ne fait rien

Si elle commence par "https://" : ajout d'un lien

Si elle contient quelque chose qui ne commence par par https :

• si la cellule est vide : ne fait rien
• sinon : cellule en rouge

Sub HyperlinkConverter()
  Dim xCell As Range

  For Each xCell In Range("E22:E10000")
    If xCell.Hyperlinks.Count = 0 Then
      If Left$(xCell.Value2, Len("https://")) = "https://" Then
        ActiveSheet.Hyperlinks.Add _
          Anchor:=xCell, _
          Address:=xCell.Value2, _
          TextToDisplay:="URL-LOCATION"
      Else
        If xCell.Value2 <> vbNullString Then xCell.Font.Color = RGB(255, 0, 0)
      End If
    End If
  Next xCell
End Sub

Ah je viens de relire votre message, pour vérifier les liens déjà existant il faut supprimer la première vérification. Soit

Sub HyperlinkConverter()
  Dim xCell As Range

  For Each xCell In Range("E22:E10000")
      If Left$(xCell.Value2, Len("https://")) = "https://" Then
        ActiveSheet.Hyperlinks.Add _
          Anchor:=xCell, _
          Address:=xCell.Value2, _
          TextToDisplay:="URL-LOCATION"
      Else
        If xCell.Value2 <> vbNullString Then xCell.Font.Color = RGB(255, 0, 0)
      End If
  Next xCell
End Sub

Bonjour ,

Encore une fois je remerçie saboh12617

un grand bravo

Je vous en prie, bonne journée.