Suppression du libellé d'un lien hypertexte

[heritias]

Bonjour ,
En tout premier, un bonne et EXCELlente année …

Je souhaiterai transformer tous les liens de la colonne "B"
Suppression du libelle du lien hypertexte (TextToDisplay = "")
Remplacer les caractère spéciaux %20 par un espace , %27 par un ‘ etc etc
Mettre le résultat dans la colonne "C"

J’aimerai donc un code VBA qui puisse faire le travail suivant :
Copier la colonne "B" de la "feuil1" sur la colonne "A" de la feuil2 (afin de ne pas perdre les infos d'origine)
Pour tout le contenu de la colonne "A" de la "feuil2"
Si le contenu de la cellule est bien un lien hypertexte
modifier les caracteres spéciaux
modifier le texte du lien en le remplacant par un blanc
Copier le résultat dans la colonne “B” de la feuil 2
Fin du si
fin de la boucle tout le contenu de la colonne

J’ai trouvé les instructions
Range(i).Select et Selection.Hyperlinks(i).TextToDisplay = "" en enregistrant la modification faite à la main dans une macro. Il y a peut-être mieux ….

N’ayant pas de notion de programmation en VBA je ne connais pas les intructions .

Merci par avance de vos réponses
Bonne journée

 

[heritias]

Re : Suppression du libellé d'un lien hypertexte

Bonjour,
pour copier la colonne j'ai trouve ceci :
Sub CopierColonne()
Sheets("Feuil1").Columns(2).Copy Sheets("Feuil2").Columns(1)
End Sub
pour supprimer les libelles de mes liens :
Sub getHyperlinks()
'used to keep track of where we are at when writing to the second sheet
Dim iWriteRow As Long
'used to hold how many columns to look through
Dim numberOfCols As Long
numberOfCols = 2
'set initial position
iWriteRow = 1

'variable used in looping through the hyperlinks
Dim h As Hyperlink
'loop through all hyper links on the sheet
For i = 1 To numberOfCols
For Each h In ActiveWorkbook.Sheets(1).Columns(i).Hyperlinks
'write them to the next sheet
ActiveWorkbook.Sheets(2).Cells(iWriteRow, i).Value = h.Address
'add 1 to our counter
iWriteRow = iWriteRow + 1
Next
iWriteRow = 1
Next i
End Sub
bon l'inconvenient c'est que mon lien de la colonne B ne se trouve pas en face de la colonne A

Concernant le remplacement des caracteres je seche un peu
j'ai bien trouvé ça :
Sub SansPonctuation() 'By Gruick
' Remplace tous les caractères spéciaux par leur équivalent naturel
' Définition de la conversion
Const Ponctuation As String = "èù"
Const NoPonctuation As String = "eu"
Dim i As Integer, C As Range
Dim lettre As String * 1
For Each mot In Selection
For Each C In Selection
C = Split(Trim(C), " (")
Next C
For i = 1 To Len(Ponctuation)
lettre = Mid$(Ponctuation, i, 1)
If InStr(mot, lettre) > 0 Then
Nllelettre = Mid$(NoPonctuation, i, 1)
mot.Replace What:=lettre, Replacement:=Nllelettre, LookAt:=xlPart
End If
Next i
Next mot
For Each C In Selection
C = Application.Trim(C)
Next C
End Sub
me permettant de remplacé les caracteres accentué mais pas un %20 ou un %27 dans le libelle de mon lien , je continu de chercher

si vous avez des idées merci par avance de votre aide .

 

[heritias]

Re : Suppression du libellé d'un lien hypertexte

Bonjour, concernant la recherche et le remplacement de caractere j'ai fait le code suivant (enfin si on peut appeler ça du code "
Sub Remplacer()
'
' %27
'
'
Columns("B:B").Select
Selection.Replace What:="%27", Replacement:="'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'
' %20
'
'
Columns("B:B").Select
Selection.Replace What:="%20", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'%c3%a9
'
'
'
Columns("B:B").Select
Selection.Replace What:="%c3%a9", Replacement:="é", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'%c3%a8
Columns("B:B").Select
Selection.Replace What:="%c3%a8", Replacement:="è", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'%2F
Columns("B:B").Select
Selection.Replace What:="%2f", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("B:B").Select
Selection.Replace What:="%2e", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("B:B").Select
Selection.Replace What:="%2c", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("B:B").Select
Selection.Replace What:="%2e", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("B:B").Select
Selection.Replace What:="%5f", Replacement:="_", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("B:B").Select
Selection.Replace What:="%2d", Replacement:="-", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns("B:B").Select
Selection.Replace What:="%c3%25", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

Avez vous une idée pour le rationnaliser ? pouvoir faire une boucle sur des codes mis dans une table avec leur correspondance dans une autre table ? avez vous une autre solution celle ci etant restrictive car j'ajoute un paragraphe à chaque fois que je touve un nouveau caractere . Merci par avance de votre aide , j'en ai bien besoin .
bonne journée