fichier déplacé quand lien entre fichiers

[zeltron]

Bonjour a tout le forum,
Voici mon pb: j'ai des liens entre 2 fichier excel: le fichier A et le Fichier B, le fichier B reprenant certaines valeurs du fichier A.
Cependant lorsque l'on déplace le fichier A, les formules dans le fichier B tombent à l'eau car elles ne retrouvent plus le fichier A. Et il faut alors refaire toutes les formules.
Dès lors j'aimerais créer une feuille 'paramètre' sur le fichier B, sur cette feuille, en D7 par ex. on indiquerait le chemin du fichier A, et dans les formules de ce fichier B on reprendrait la valeur de D7 de la feuille 'paramètre'. Ainsi lorsque le fichier A sera déplacé, il suffira sur la feuille paramètre du fichier B, d'indiquer simplement le nouvel endroit où se trouve ce fichier A; ce qui éviterait de refaire toutes les formules du fichier B.

Pouvez vous m'aider? Car la je nage!!!

Ou est ce tout simplement impossible.? J'espère que les 'pros' seront me prouver le contraire!!!

Par avance merci

Cordialement

[file name=ClassseurB.zip size=3006]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/ClassseurB.zip[/file]

 

[myDearFriend!]

Bonsoir zeltron,

Ci-joint, peut-être une façon de faire...

J'ai utilisé le code ci-dessous :

DANS LE MODULE DE CODE DE LA FEUILLE 'PARAMETRES'

Private Sub Worksheet_Change(ByVal Target As Range)
      If Not Application.Intersect(Target, Range('D7')) Is Nothing Then
            ModifLiens Target.Value
      End If
End Sub

DANS UN MODULE DE CODE GENERAL (Module1)

Sub ModifLiens(NouvAdresse As String)
'myDearFriend! - 20/11/05
Dim Feuille As Worksheet
Dim Plage As Range, Cellule As Range
Dim F As String, Source As String
Dim Pos As Byte
      'Nom du classeur Source
      Source = Sheets('Paramètres').Range('D6').Value
      'Traitement
      If Dir(NouvAdresse & '\' & Source) <> '' Then
            If MsgBox('Modifier les liens ?', vbYesNo + vbQuestion) = vbYes Then
                  'Modification des liens sur chaque feuille du classeur Cible
                  For Each Feuille In ThisWorkbook.Worksheets
                        If Feuille.Name <> 'Paramètres' Then
                              Set Plage = Feuille.UsedRange.SpecialCells(xlCellTypeFormulas, 23)
                              For Each Cellule In Plage
                                    F = Cellule.FormulaLocal
                                    Pos = InStr(1, F, '[' & Source & ']')
                                    If Pos > 0 Then
                                          Cellule.FormulaLocal = '='' & NouvAdresse & '\' & Mid(F, Pos)
                                    End If
                              Next Cellule
                        End If
                  Next Feuille
                  Exit Sub
            End If
      Else
            MsgBox 'Pas de ''' & Source & ''' sous le chemin indiqué !', vbOKOnly, 'Erreur !'
      End If
     
      'Annuler si le chemin n'est pas le bon
      With Application
            .EnableEvents = False
            .Undo
            .EnableEvents = True
      End With
End Sub

Cordialement, [file name=mDF_LiensRompus.zip size=16564]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/mDF_LiensRompus.zip[/file]

 

[zeltron]

Merci Mdf, pour ton aide. Je vais etudier ta solution, et n'hésiterai pas a revenir vers toi si j'ai de plus ample questions.
Merci encore

Cordialement

Zelton