Discussion :

[GADENSEB]

C'est bon cela marche avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub ANNONCE_Click()
Dim C As Range
 cherch = CODEBASE
On Error Resume Next
With Sheets("BASE EMPLOI")
    Set C = .Range("A2:A2500").Find(cherch, LookIn:=xlValues, lookat:=xlWhole)
 
   If Not C Is Nothing Then
        C.Offset(0, 39).Hyperlinks(1).Follow True
        Application.Goto .Range(C.Offset(0, 39).Hyperlinks(1).SubAddress)
     Set C = Nothing
  End If
End With
End Sub

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
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 :

Sélectionner tout - Visualiser dans une fenêtre à part

E:\SEB PERSONNEL\TRAVAIL\ANNONCES REPONDUES\2014\

Mon DD externe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Du coup que la valeur

E ou T puiss changer automatiquement sans me casser la tête ......

[GADENSEB]

Bonjour le Fil

Voila un code qui marche nikel
Merci à tous
Bonne journée
seb

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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