Copier cellule contenant lien Hypertexte Via VBA

Le 25/10/2022 à 17:04

Bonjour,

Je cherche à copier une cellule d'un fichier Excel A vers un fichier Excel B en conservant son lien hypertexte.

J'ai essayer pas mal de choses trouvé en ligne sans résultats et le mieux que j'ai réussi à faire le liens c'est copier mais tout les / ce sont transformé en \ du coup ça ne fonctionne pas.

Je n'ai aucun problème a copier la cellule j'ai juste besoin de savoir comment fonctionne la copie de lien hypertexte.

Quelqu'un peut m'aider ?

voici le code qui "fonctionne" le mieux mais qui inverse les "/" et les "\" (c'est la partie tout en commentaire) je n'arrive pas vraiment à adapté la fonction je n'ai pas vraiment besoin de la boucle personnellement

Private Sub Worksheet_Change(ByVal Target As Range)

'info utile poste
'Si la céllule I11 change lance le code
If Target.Address = "$I$11" Then

'déclaration des variables
Dim IndBoucle As Integer
Dim IndLAD As Integer
Dim NumBoucle As Integer
Dim Chemin As String
Dim NomFichier As String
Dim OngletPASI As Worksheet
Dim OngletPDTPASI As Worksheet
Dim FichierInformationsPostes As Workbook
Dim FichierPDT As Workbook
Dim FichierPASI As Workbook
Dim site As String
Dim NomDePoste As String

Chemin = Sheets("Données").Range("J51")
IndBoucle = 5
IndLAD = 2
NomDePoste = Sheets("Page1").Range("I11").Value

'set les variables du fichier PDT
Set FichierPDT = ThisWorkbook
Set OngletPDTPASI = FichierPDT.Worksheets("PASI")
'Ouvre fichier PASI
Set FichierPASI = Application.Workbooks.Open(Filename:=Chemin)
Set OngletPASI = FichierPASI.Worksheets("Tableau de suivi")

'Affiche l'onglet PASI
OngletPDTPASI.Visible = True

'Recherche Du poste

While (OngletPASI.Range("C" & IndBoucle).Value <> "")

'Si il trouve le poste dans le fichier PASI
If OngletPASI.Range("C" & IndBoucle).Value = NomDePoste Then
OngletPDTPASI.Range("A" & IndLAD).Value = OngletPASI.Range("A" & IndBoucle).Value 'rempli le Tableau PASI colone A
OngletPDTPASI.Range("B" & IndLAD).Value = OngletPASI.Range("B" & IndBoucle).Value 'rempli le Tableau PASI colone B
OngletPDTPASI.Range("C" & IndLAD).Value = OngletPASI.Range("C" & IndBoucle).Value 'rempli le Tableau PASI colone C
OngletPDTPASI.Range("D" & IndLAD).Value = OngletPASI.Range("D" & IndBoucle).Value 'rempli le Tableau PASI colone D
OngletPDTPASI.Range("E" & IndLAD).Value = OngletPASI.Range("E" & IndBoucle).Value 'rempli le Tableau PASI colone E
OngletPDTPASI.Range("F" & IndLAD).Value = OngletPASI.Range("F" & IndBoucle).Value 'rempli le Tableau PASI colone F
OngletPDTPASI.Range("G" & IndLAD).Value = OngletPASI.Range("G" & IndBoucle).Value 'rempli le Tableau PASI colone G
OngletPDTPASI.Range("H" & IndLAD).Value = OngletPASI.Range("H" & IndBoucle).Value 'rempli le Tableau PASI colone H
OngletPDTPASI.Range("I" & IndLAD).Value = OngletPASI.Range("I" & IndBoucle).Value 'rempli le Tableau PASI colone I
OngletPDTPASI.Range("J" & IndLAD).Value = OngletPASI.Range("J" & IndBoucle).Value 'rempli le Tableau PASI colone J
OngletPDTPASI.Range("K" & IndLAD).Value = OngletPASI.Range("K" & IndBoucle).Value 'rempli le Tableau PASI colone K
OngletPDTPASI.Range("L" & IndLAD).Value = OngletPASI.Range("L" & IndBoucle).Value 'rempli le Tableau PASI colone L

OngletPDTPASI.Range("M" & IndLAD).Value = OngletPASI.Range("M" & IndBoucle).Value 'rempli le Tableau PASI colone M

'copie lien hypertexte PASI
' Set xSRg = OngletPASI.Range("M" & IndBoucle)
' Set xDRg = OngletPDTPASI.Range("M" & IndLAD)
' Set xDRg = xDRg(1)
' For I = 1 To xSRg.Count
' If xSRg(I) <> "" And xDRg.Offset(I - 1) <> "" Then
' If xSRg(I).Hyperlinks.Count = 1 Then
' xDRg(I).Hyperlinks.Add xDRg(I), xSRg(I).Hyperlinks(1).Address
' End If
' End If
'Next

OngletPDTPASI.Range("N" & IndLAD).Value = OngletPASI.Range("N" & IndBoucle).Value 'rempli le Tableau PASI colone N
OngletPDTPASI.Range("O" & IndLAD).Value = OngletPASI.Range("O" & IndBoucle).Value 'rempli le Tableau PASI colone O
OngletPDTPASI.Range("P" & IndLAD).Value = OngletPASI.Range("P" & IndBoucle).Value 'rempli le Tableau PASI colone P
OngletPDTPASI.Range("Q" & IndLAD).Value = OngletPASI.Range("Q" & IndBoucle).Value 'rempli le Tableau PASI colone Q

IndLAD = IndLAD + 1
End If

IndBoucle = IndBoucle + 1

Wend

'Si il trouve le poste dans le fichier PASI
If (IndLAD <> 2) Then

If MsgBox("Des Particularités ASI sont présent dans le poste veuillez en prendre connaissance", vbOKOnly + vbExclamation) = vbOK Then
End If

ElseIf IndLAD = 2 Then
'ferme onglet LAD si rien trouvé
OngletPDTPASI.Visible = False

End If

FichierPASI.Close 'Ferme le tableau de suivi

'Pour revenir sur page1
ActiveWorkbook.Worksheets("Page1").Activate

End If

Edit modo : code mis entre balises (merci d'y faire attention)

Le 25/10/2022 à 19:19

Bonjour ozxo et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire :
- La charte du forum
- Quelques fonctionnalites du forum à connaître

Regardez aussi les petites icônes mises à votre disposition dans la barre de menu qui :
- vous permettent de poster un code (</>) Merci d'y faire attention SVP
- de citer une phrase (" ")
- ou de clôturer un fil lorsque vous avez terminé (V)

Merci pour votre participation

Cordialement

Rechercher des sujets similaires à "copier contenant lien hypertexte via vba"