ecrire dans un fichier en changeant le lien hypertexte

obyone

XLDnaute Occasionnel
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....
 

Pièces jointes

  • Doc essai.xlsm
    39.7 KB · Affichages: 26
  • Tachy essai.xlsm
    15.9 KB · Affichages: 19

Discussions similaires

Statistiques des forums

Discussions
312 273
Messages
2 086 701
Membres
103 373
dernier inscrit
Edouard007