Copie ou déplacement de liens hypertexte

[Gedch]

Bonjour

Il y a beaucoup de possibilités de copies dans les options
Mais je ne vois rien qui concerne les liens hypertextes

Je n'ai rien trouvé sur le net non plus.

Cela serait étonnant que l'on puisse pas le faire
SI quelqu'un connait la solution ?

Merci d'avance

 

[Gedch]

Re : Copie ou déplacement de liens hypertexte

Re,

Je suppose que ces 3 nouveaux codes ne sont pas en rapport à mon post 13 ?

Mais je ne comprends pas trop leurs portées ?

A+

 

[job75]

Re : Copie ou déplacement de liens hypertexte

Re,

Testez l'une et l'autre des macros du post #15.

Si l'on copie/colle une cellule contenant un lien hypertexte, seul le lien hypertexte est copié.

La 1ère macro si l'on ne veut pas copier le texte de la cellule, la 2ème macro si l'on veut copier le texte.

A+

 

[Gedch]

Re : Copie ou déplacement de liens hypertexte

RE,

J'avais bien essayé les 2 codes du post #15
Je viens de le refaire
Mais je ne vois pas de différence
Le texte ne se copie pas ?

Le lien lui se copie bien avec les 2 codes

A+

 

[job75]

Re : Copie ou déplacement de liens hypertexte

Re,

Avec TextToDisplay le texte est copié, du moins sur Excel 2010.

On peut aussi utiliser :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a$, sa$, d$
If Target.Count = 1 Then
  If Target.Hyperlinks.Count = 1 Then
    a = Target.Hyperlinks(1).Address
    sa = Target.Hyperlinks(1).SubAddress
    d = Target
    Application.EnableEvents = False
    Application.Undo
    Target = d
    If a = "" Then Me.Hyperlinks.Add Target, a, sa _
      Else Me.Hyperlinks.Add Target, a
    Application.EnableEvents = True
  End If
End If
End Sub

A+

 

[Gedch]

Re : Copie ou déplacement de liens hypertexte

Bonsoir

Pardons j'avais mal compris les macros

C'est génial 😱

Vos 2 macros fonctionnent parfaitement sur 2007
Pour le copiage c'est exactement ce que je souhaitais

Serait-il possible de faire la même chose, mais en déplacement du lien

Exemple :
Transférer le lien d'une cellule sur une autre cellule
sans toucher au texte ou nombre présent dans les 2 cellules

A+

 

[job75]

Re : Copie ou déplacement de liens hypertexte

Bonjour Gedch, le forum,

Pour transférer d'une cellule à une autre il n'y a a priori que 2 méthodes :

- le copier-coller

- le glissement-déplacement (poignée en bas à droite de la cellule).

Si vous ne voulez pas copier le texte de la cellule, utilisez comme je l'ai dit la 1ère macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a$, sa$
If Target.Count = 1 Then
  If Target.Hyperlinks.Count = 1 Then
    a = Target.Hyperlinks(1).Address
    sa = Target.Hyperlinks(1).SubAddress
    Application.EnableEvents = False
    Application.Undo
    If a = "" Then Me.Hyperlinks.Add Target, a, sa _
      Else Me.Hyperlinks.Add Target, a
    Application.EnableEvents = True
  End If
End If
End Sub

Edit : attention avec le glissement-déplacement, une seule cellule à la fois...

A+

 

[job75]

Re : Copie ou déplacement de liens hypertexte

Re,

Pour le copier-coller ou glissement-déplacement sur plusieurs cellules, on peut convenir d'exécuter la macro si la 1ère cellule cible contient un lien hypertexte.

Il suffit alors d'une boucle :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a$, sa$
If Target(1).Hyperlinks.Count = 1 Then
  a = Target(1).Hyperlinks(1).Address
  sa = Target(1).Hyperlinks(1).SubAddress
  Application.EnableEvents = False
  Application.Undo
  For Each Target In Target 'si plusieurs cellules
    If a = "" Then Me.Hyperlinks.Add Target, a, sa _
      Else Me.Hyperlinks.Add Target, a
  Next
  Application.EnableEvents = True
End If
End Sub

A+

 

[Gedch]

Re : Copie ou déplacement de liens hypertexte

Bonjour

Je ne suis pas très bien pour le déplacement :

Pour transférer d'une cellule à une autre il n'y a a priori que 2 méthodes :

- le copier-coller

Le copier-coller, c'est une copie, pas un déplacement ?

- le glissement-déplacement (poignée en bas à droite de la cellule).

J'obtiens un message d'erreur ou je ne comprends pas la procédure ?

Si vous ne voulez pas copier le texte de la cellule, utilisez comme je l'ai dit la 1ère macro

Là c'est bien compris et le copiage s'effectue sans problème


Merci et A+

 

[job75]

Re : Copie ou déplacement de liens hypertexte

Re,

Pas compris ce que vous faites pour arriver à obtenir un message d'erreur 😕

Quel est le message et quelle ligne beugue ?

Et avez-vous testé la macro de mon post #22 ?

A+

 

[Gedch]

Re : Copie ou déplacement de liens hypertexte

Re,

avez-vous testé la macro de mon post #22 ?

Oui, je l'ai testé et cela fonctionne
Mais par contre, quand vous parler de copier plusieurs liens hypertexte
Vous voulez dire copier un lien vers plusieurs cellules ?
Soit copier le lien de la cellule A1 vers B1:B4

Car si je veux copier les liens hypertexte des cellules A1:A4 vers B1:B4
Cela ne fonctionne pas.

Quel est le message et quelle ligne beugue

Je n'ai plus ce message d'erreur
J'ai fait plusieurs essais et je n'arrive plus à tomber sur cette erreur

Mais par contre je n'arrive toujours pas à déplacer un lien
Soit déplacer le lien de la cellule A1 vers A4

Si je fais couper/coller je n'obtiens rien
Et pour le le glissement-déplacement, je ne vois pas comment faire ??

A+

 

[job75]

Re : Copie ou déplacement de liens hypertexte

Re,

Attention, si vous avez eu une erreur, il faut fermer et rouvrir le fichier (à cause des Application.EnableEvents).

Maintenant pour copier les liens hypertextes de A1:A4 vers B1:B4 il faut mémoriser les liens de toutes les cellules.

Cela se fait par les tableaux a et sa :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a$(), sa$(), t, n&
If Target(1).Hyperlinks.Count Then
  If Target.Count > 10000 Then Exit Sub 'adapter le nombre maximum de cellules
  ReDim a(1 To Target.Count)
  ReDim sa(1 To Target.Count)
  For Each t In Target
    n = n + 1
    If t.Hyperlinks.Count Then
      a(n) = t.Hyperlinks(1).Address
      sa(n) = t.Hyperlinks(1).SubAddress
    End If
  Next
  n = 0
  Application.EnableEvents = False
  Application.Undo
  For Each t In Target
    n = n + 1
    If a(n) <> "" Or sa(n) <> "" Then
      If a(n) = "" Then Me.Hyperlinks.Add t, a(n), sa(n) _
        Else Me.Hyperlinks.Add t, a(n)
      End If
  Next
  Application.EnableEvents = True
End If
End Sub

La 1ère cellule (A1) doit contenir un lien pour que la macro s'exécute.

A+

 

[Gedch]

Re : Copie ou déplacement de liens hypertexte

Re,

Attention, si vous avez eu une erreur, il faut fermer et rouvrir le fichier (à cause des Application.EnableEvents).

Oui, effectivement je m'en étais aperçu
Car au lieu de copier seulement le lien, je copiais toute la cellule.

Maintenant pour copier les liens hypertextes de A1:A4 vers B1:B4 il faut mémoriser les liens de toutes les cellules.

Super, là c'est bien plus que j'en demandais 😛


Pour le déplacement des liens au lieu de leur copiage, si cela n'est pas possible
Puisque que maintenant, on peut copier plusieurs liens à la fois
Il serait peut-être plus simple, avec l'aide d'une 2ème macro, si celle-ci est réalisable ?
de pouvoir tout simplement supprimer un ensemble de liens
Cela permettrait donc par exemple de copier une dizaine de liens
Puis dans un second temps de supprimer la dizaine de liens qui ont été copiés 😕

A+

 

[job75]

Re : Copie ou déplacement de liens hypertexte

Re,

Pas compris votre post #27.

En tout cas ma macro ne permet pas de savoir quelles sont les cellules sources.

A+

 

[Gedch]

Re : Copie ou déplacement de liens hypertexte

Re,

Je m'explique plus clairement, du moins je l'espère

Je ne sais pas si j'ai mal compris votre façon de faire dans votre post #21
A savoir :

Pour transférer d'une cellule à une autre il n'y a a priori que 2 méthodes :

- le copier-coller

- le glissement-déplacement (poignée en bas à droite de la cellule).

Mais je n'arrive pas à transférer les liens
Pour moi transférer c'est déplacer
Mais peut-être que ce n'est pas de cela que vous parliez ?
Et peut-être que cela est tout bonnement impossible ??

Donc dans mon dernier post #27
Je me disais, vu que maintenant avec votre dernière macro
Il est possible de copier tout un ensemble de liens à la fois, 10, 20 voir plus

Si par exemple j'ai besoin de déplacer 20 liens
Avec l'aide votre dernière macro, en 1 opération je copie ces 20 liens

Reste que ensuite ces liens sources sont toujours en place et que je dois donc les effacer
Pour ce faire, je peux faire un clic droit et faire supprimer
Le problème, c'est qu'il va falloir le faire 20 fois !

Donc, peut-être qu'une seconde macro, totalement indépendante
en sélectionnant à nouveau les cellules sources contenant les liens d'origine
permettrait d’effacer d'un coup tous ces liens qui n'ont plus raison d'être ??


Peut-être plus clair?
J'ai une vingtaine de liens hypertexte dans les cellules A1:A30
Je souhaite les déplacer dans les cellules B1:B30
Je fais donc un clic droit sur A1, je sélectionne copie
je clique sur la cellule B1 et je valide.
Je me trouve donc à présent avec les mêmes liens à la fois dans les colonnes A et B

Il me reste donc la tache de supprimer les liens de la colonne A
Pour ce faire, si une macro est réalisable
Je pourrais ainsi supprimer d'un coup tous les liens de la colonne A

A+

 

[job75]

Re : Copie ou déplacement de liens hypertexte

Re,

Après la copie d'un lien on peut supprimer tous les liens identiques dans le reste de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a$(), sa$(), t, n&, h As Hyperlink
If Target(1).Hyperlinks.Count Then
  If Target.Count > 10000 Then Exit Sub 'adapter le nombre maximum de cellules
  ReDim a(1 To Target.Count)
  ReDim sa(1 To Target.Count)
  For Each t In Target
    n = n + 1
    If t.Hyperlinks.Count Then
      a(n) = t.Hyperlinks(1).Address
      sa(n) = t.Hyperlinks(1).SubAddress
    End If
  Next
  n = 0
  Application.EnableEvents = False
  Application.Undo
  For Each t In Target
    n = n + 1
    If a(n) <> "" Or sa(n) <> "" Then _
      If a(n) = "" Then Me.Hyperlinks.Add t, a(n), sa(n) _
        Else Me.Hyperlinks.Add t, a(n)
    For Each h In Me.Hyperlinks
      If Intersect(h.Parent, Target) Is Nothing And h.Address = a(n) _
        And h.SubAddress = sa(n) Then h.Delete
    Next
  Next
  Application.EnableEvents = True
End If
End Sub

Noter que la suppression d'un lien supprime aussi tous les formats de la cellule.

A+