Liens hypetextes aléatoires en fonction de mon DD portable ou Pc

GADENSEB

XLDnaute Impliqué
Bonsoir le Forum,


Le problème vient que je transporte mon fichier entre mon dd externe et mon pc
j'ai des problèmes avec les lien hypertextes du coup une macro les corrige automatiquement





Code:
Sub LIENHYPERTEXTEMODIF()
With Sheets("BASE EMPLOI")
Dim Lien As Hyperlink
Dim AncienTexte As String
Dim NouveauTexte As String
 
AncienTexte = "C:\Users\Sébastien GADEN\AppData\Roaming\Microsoft\Excel\ANNONCES REPONDUES\"
NouveauTexte = "T:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"
 
For Each Lien In ThisWorkbook.Sheets("BASE EMPLOI").UsedRange.Hyperlinks
   Lien.Address = Replace(Lien.Address, AncienTexte, NouveauTexte)
Next
End With
End Sub



ou
c: est mon PC

T: mon dd portable

mmmmm comment faire pour que l'adressage soit
Mon pc :
Code:
E:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\2014\

Mon DD externe

Code:
T:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\2014\


Du coup que la valeur

E ou T puissent changer automatiquement sans me casser la tête ......en fonction d'ou j'ouvre mon fichier...


Bonne soirée
Seb
 

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Liens hypetextes aléatoires en fonction de mon DD portable ou Pc

Bonjour Seb

avec ce test à l'ouverture , tu pourras modifier les liens hypertexte en fonction de l'emplacement du fichier

E pour le Pc
T pour le DD externe

Code:
Private Sub Workbook_Open()

If Left(ActiveWorkbook.Path, 1) = "E" Then
'-------------
' code pour modifier les liens 
'-------------
End If

If Left(ActiveWorkbook.Path, 1) = "T" Then
'-------------
' code pour modifier les liens 
'-------------
End If

End Sub


à+
Philippe
 
Dernière édition:

GADENSEB

XLDnaute Impliqué
Re : Liens hypetextes aléatoires en fonction de mon DD portable ou Pc

Merci !


du coup j'ai modulé ce code
la lettre de lecteur E étant en fait D
J'ai placé ce code dans un module, ou dois-je le placé dans un onglet ?
Cela ne marche pas

Il me semble que j'ai mal placé mon With Sheets("BASE EMPLOI")
Avec les With sheets on doit placer des "." devant les attibuts mais là je ne vois pas ou les placer ......




Code:
Private Sub Workbook_Open()
With Sheets("BASE EMPLOI")
Dim Lien As Hyperlink
Dim AncienTexte As String
Dim NouveauTexte As String


If Left(ActiveWorkbook.Path, 1) = "T" Then
'-------------
' code pour modifier les liens
'-------------
AncienTexte = "D:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"
NouveauTexte = "T:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"
 
For Each Lien In ThisWorkbook.Sheets("BASE EMPLOI").UsedRange.Hyperlinks
   Lien.Address = Replace(Lien.Address, AncienTexte, NouveauTexte)
Next
End With
End If

'------------------------------------------------------------------------------


If Left(ActiveWorkbook.Path, 1) = "D" Then
'-------------
' code pour modifier les liens
'-------------

AncienTexte = "T:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"
NouveauTexte = "D:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"
 
For Each Lien In ThisWorkbook.Sheets("BASE EMPLOI").UsedRange.Hyperlinks
   Lien.Address = Replace(Lien.Address, AncienTexte, NouveauTexte)
Next
End With


End If
End If
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Liens hypetextes aléatoires en fonction de mon DD portable ou Pc

Bonjour GADENSEB, bonjour phlaurent55,

En attendant le retour phlaurent55 (que je salue :) ),
.

  • le code proposé par phlaurent55 ne se met ni dans un module de code, ni dans le module de code d'une feuille. Il se place dans le module de code de ThisWorkbook (dit module de classeur). La procédure sera exécutée à chaque ouverture du classeur.


  • en reprenant une partie de ton code et de celui de phlaurent55, je te propose un code un peu plus concis (à tester):
.
VB:
Private Sub Workbook_Open()

Const CheminD = "D:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"
Const CheminT = "T:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"

Dim Lien As Hyperlink, leTexte As String, parTexte As String
  ' définir quelle chaine à remplacer par quelle chaine
  Select Case Left(ActiveWorkbook.Path, 1)
    Case "T", "t"
      leTexte = CheminD: parTexte = CheminT
    Case "D", "d"
      leTexte = CheminT: parTexte = CheminD
    Case Else
      MsgBox "Au moins un des disques n'est ni D: ni T:"
      Exit Sub
  End Select
   
  ' code pour modifier les liens
  For Each Lien In ThisWorkbook.Sheets("BASE EMPLOI").UsedRange.Hyperlinks
     Lien.Address = Replace(Lien.Address, leTexte, parTexte, , , vbTextCompare)
  Next
End Sub
 
Dernière édition:

GADENSEB

XLDnaute Impliqué
Re : Liens hypetextes aléatoires en fonction de mon DD portable ou Pc

Hello



Super Code !!

Par contre, j'ai une erreur d’exécution 13 - Incompatibilité de type

Code:
Lien.Address = Replace(1, Lien.Address, leTexte, parTexte, vbTextCompare)
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Liens hypetextes aléatoires en fonction de mon DD portable ou Pc

Re,

Mille excuses ! J'ai mélangé la syntaxe du Replace avec celle de Instr :mad:

Utiliser:
VB:
Lien.Address = Replace(Lien.Address, leTexte, parTexte, , , vbTextCompare)

C'est mieux ?
 
Dernière édition:

GADENSEB

XLDnaute Impliqué
Re : Liens hypetextes aléatoires en fonction de mon DD portable ou Pc

Parfait

Un grand merci à toi et au Forum


Bonne journée

Seb

Code:
Private Sub Workbook_Open()

Const CheminD = "D:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"
Const CheminT = "T:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\"

Dim Lien As Hyperlink, leTexte As String, parTexte As String
  ' définir quelle chaine à remplacer par quelle chaine
 Select Case Left(ActiveWorkbook.Path, 1)
    Case "T", "t"
      leTexte = CheminD: parTexte = CheminT
    Case "D", "d"
      leTexte = CheminT: parTexte = CheminD
    Case Else
      MsgBox "Au moins un des disques n'est ni E: ni T:"
      Exit Sub
  End Select
   
  ' code pour modifier les liens
 For Each Lien In ThisWorkbook.Sheets("BASE EMPLOI").UsedRange.Hyperlinks
     Lien.Address = Replace(Lien.Address, leTexte, parTexte, , , vbTextCompare)
  Next
End Sub
 

Statistiques des forums

Discussions
312 756
Messages
2 091 748
Membres
105 062
dernier inscrit
Ret78