ecrire dans un fichier en changeant le lien hypertexte

obyone · 10 Mai 2016

bonjour,
je dispose de 2 fichiers

lorsque que j'ajoute un fichier via le userform dans doc essai.xlsm onglet SI_VDO
je souhaite qu'il s'inscrive sur le tableau correspondant puis sur le tableau accueil avec son lien hypertext: "\xxx.xxx.xxx.xx\dossier\nom du fichier..."

puis dans un autre classeur nommé tachy essai.xlsm les memes copie sauf pour le lien qui deviendrait
"C:\transfert doc\dossier\nom du fichier..."

j'ai essayé cette macro mais cela ne fonctionne pas quelqu'un à une idée?

Code:

Private Sub Ajouter_click()
Dim C As Range
Dim i As Integer
Dim fic As String, monclasseur As String
tachy = "C:\Users\xxx\Desktop\Tachy essai.xlsm"

With Worksheets("Accueil").Select
   i = 2
    Do While Cells(i, 1) <> ""
      Cells(i, 4).Offset(1, 0).Select 'case selectionnée
      i = i + 1
    Loop
    ActiveCell.Offset(0, -3).Value = "VDO"
    ActiveCell.Offset(0, -2).Value = ModifVDO.TB_Noms.Value 'ajout TB noms 3 case avant
    ActiveCell.Offset(0, -1).Value = ModifVDO.TB_Date.Value 'ajout date 1 case avant
    ActiveCell.Offset(0, 0).Value = ModifVDO.TB_Description.Value 'ajout description
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=("\\128.60.150.7\" & Me.TB_Lien.Value)
    ActiveCell.Offset(0, 4).Value = Format(Now, "mm/dd/yyyy")
    End With
   
   With Worksheets("SI_VDO").Select
       i = 2
    Do While Cells(i, 1) <> ""
      Cells(i, 4).Offset(1, 0).Select 'case selectionnée
      i = i + 1
    Loop
    ActiveCell.Offset(0, -3).Value = ModifVDO.TB_Noms.Value 'ajout TB noms 3 case avant
    ActiveCell.Offset(0, -1).Value = ModifVDO.TB_Date.Value 'ajout date 1 case avant
    ActiveCell.Offset(0, 0).Value = ModifVDO.TB_Description.Value 'ajout description
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=Me.TB_Lien.Value
    If Abrogé.Value = True Then Cells(ligne, 2) = "x" 'ajout "x" si abrogé
    End With
  Range("SIVDO").Columns("a").Sort Key1:=Range("SIVDO").Columns("a"), Header:=xlYes ' tri le tableau "SIVDO" du plus petit au plus grand

'ouverture classeur tachy
Workbooks.Open (tachy)
monclasseur = ActiveWorkbook.Name

With Worksheets("Accueil").Select
   i = 2
    Do While Cells(i, 1) <> ""
      Cells(i, 4).Offset(1, 0).Select 'case selectionnée
      i = i + 1
    Loop
    ActiveCell.Offset(0, -3).Value = "VDO"
    ActiveCell.Offset(0, -2).Value = ModifVDO.TB_Noms.Value
    ActiveCell.Offset(0, -1).Value = ModifVDO.TB_Date.Value
    ActiveCell.Offset(0, 0).Value = ModifVDO.TB_Description.Value
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=("C:\Tranfert doc\" & Me.TB_Lien.Value)
    ActiveCell.Offset(0, 4).Value = Format(Now, "mm/dd/yyyy")
    End With
   
   With Worksheets("SI_VDO").Select
       i = 2
    Do While Cells(i, 1) <> ""
      Cells(i, 4).Offset(1, 0).Select 'case selectionnée
      i = i + 1
    Loop
    ActiveCell.Offset(0, -3).Value = ModifVDO.TB_Noms.Value 'ajout TB noms 3 case avant
    ActiveCell.Offset(0, -1).Value = ModifVDO.TB_Date.Value 'ajout date 1 case avant
    ActiveCell.Offset(0, 0).Value = ModifVDO.TB_Description.Value 'ajout description
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=("C:\Tranfert doc\" & Me.TB_Lien.Value)
    If Abrogé.Value = True Then Cells(ligne, 2) = "x" 'ajout "x" si abrogé
    End With
  Range("SIVDO").Columns("a").Sort Key1:=Range("SIVDO").Columns("a"), Header:=xlYes ' tri le tableau "SIVDO" du plus petit au plus grand

ActiveWorkbook.Save 'sauvegarde
Workbooks(monclasseur).Close 'fermeture

Unload Me
End Sub

merci d'avance....

ecrire dans un fichier en changeant le lien hypertexte

obyone

XLDnaute Occasionnel

Pièces jointes

Discussions similaires