[XL-2010] liaison entre fichier Excel

[amouna98]

bonjour,

Je suis débutante en VBA et c'est la première foi que je fais des liaisons entre fichier excel

J'ai 2 fichiers Excel leurs 2eme feuille est un tableau de 2 colonnes et plusieurs lignes je cherche a mettre à jour le tableau du fichier1 quand je modifie le tableau du fichier2, les 2 fichiers sont enregistrés sur serveur
J'ai commencé par faire un lien, sauf que ca modifie pas si j’insert une ligne entre 2 lignes existantes
En plus il a suffi que je perds la communication avec le serveur que les liaisons fonctionnent plus !!! Je ne comprends pas pourquoi j'ai du les effacé puis les refaire quand je me suis reconnecté sur le serveur
j'ai pensé à faire une macro (je crois que c'est plus fiable)est ce une bonne idée si oui comment faire merci

[Daniel.C]

Bonjour,
Quand tu dis "tableau", tu te réfères à une plage de cellules ou à un tableau au sens XL2010 du terme (Insertion, Tableau) ?

[amouna98]

Bonjour
Je parle de 2 colonnes et plusieurs ligne (nombre non défini) elle évolue l'idée est d'évoluer le 2eme fichier de la même façon (si on insert une ligne dans le 1er fichier il doit l'insérer dans le 2eme si on ajout une ligne dans le 1er fichier il faut qu'il ajoute dans le 2eme fichier ...)
Il faut qu'on est a tout temps la même chose
Je précise que c'est 2 colonnes c'est tout ce que j'ai dans cette feuille (c’est comme un dico des codes et leurs significations)

[Daniel.C]

Bonjour,

En supposant que le fichier où l'on répercute les modifs soit "c:\temp\Fichier1.xls"; les tableaux sont tous les deux sur Feuil1 en colonne A:B commençant en cellule A1. Mets la macro suivante dans le module de Feuil1 du classeur où tu fais les modifs (Fichier2.xls) :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WB As Workbook, Teste As Boolean
    If Intersect(Target, Range("A1").CurrentRegion) Is Nothing Then Exit Sub
    For Each WB In Workbooks
        If WB.Name = "Fichier1.xls" Then '*** à modifier
            Teste = True
            WB.Activate
            Exit For
        End If
    Next WB
    If Teste = False Then
        Workbooks.Open "c:\temp\Fichier1.xls" '*** à modifier
    End If
    With Target.Worksheet
        ActiveWorkbook.Sheets("Feuil1").[A:B].Clear
        Intersect(.[A1].CurrentRegion, .[Feuil1!A:B]).Copy
        ActiveWorkbook.Sheets("Feuil1").[A1].PasteSpecial xlPasteValues
    End With
End Sub

Si tu as des difficultés avec les macros, n'hésite pas à poser des questions.

[amouna98]

j'ai un probleme !!!
l'erreur est : Erreur d'exécution 424 : Objet requis !!!
j'ai fait peu de modif dans le code

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub copie()
 Dim WB As Workbook, Teste As Boolean
    If Intersect(Target, Range("C4").CurrentRegion) Is Nothing Then Exit Sub
    For Each WB In Workbooks
        If WB.Name = "RAF_Gabarits.xls" Then 
            Teste = True
            WB.Activate
            Exit For
        End If
    Next WB
    If Teste = False Then
        Workbooks.Open "C:\Documents and Settings\Mes documents\RAF_Gabarits.xls" '*** à modifier
    End If
    With Target.Worksheet
        ActiveWorkbook.Sheets("Feuil2").[C:D].Clear
        Intersect(.[C4].CurrentRegion, .[Feuil2!C:D]).Copy
        ActiveWorkbook.Sheets("Feuil2").[C4].PasteSpecial xlPasteValues
    End With
End Sub

j'ai caraiment créer des fichiers pour tester le code ( voir ci-joint)

[Daniel.C]

Je n'ai pas modifié le classeur "RAF_Gabarits.xlsx"; j'ai enregistré "RAF_template_macro.xlsx" au format XL2003 ("RAF_template_macro.xls"), la format xlsm n'étant pas admis comme type de pièce jointe. J'ai modifié le code en fonction de la disposition de tes données et j'ai mis la macro dans le module de Feuil2 :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WB As Workbook, Teste As Boolean
    If Intersect(Target, Intersect([C4].CurrentRegion, [C:D])) Is Nothing Then Exit Sub
    For Each WB In Workbooks
        If WB.Name = "RAF_Gabarits.xlsx" Then '*** à modifier
            Teste = True
            WB.Activate
            Exit For
        End If
    Next WB
    If Teste = False Then
        Workbooks.Open ThisWorkbook.Path & "\RAF_Gabarits.xlsx" '*** à modifier
    End If
    With Target.Worksheet
        ActiveWorkbook.Sheets("Feuil2").[C:D].Clear
        Intersect(.[C4].CurrentRegion, .[Feuil2!C:D]).Copy
        ActiveWorkbook.Sheets("Feuil2").[C4].PasteSpecial xlPasteValues
    End With
End Sub

[amouna98]

j'ai repris ton fichier j'ai copier puis collé ton code mais j'ai toujour la meme erreur sur la ligne

Code :

If Intersect(Target, Intersect([C4].CurrentRegion, [C:D])) Is Nothing Then

[Daniel.C]

Le code était DEJA dans le fichier que je t'ai retourné. Teste-le sans rien modifier.

[ZebreLoup]

Ce que Daniel a fait c'est qu'il a mis le code dans l'évènement Worksheet_Change de la feuille en question. Du coup, il va s'exécuter dès que tu vas changer une valeur dans la feuille

Ça ne marchera pas si tu essaies de lancer la macro directement car Target représente la cellule qui a été modifiée. Tu aurais d'ailleurs eu un problème de compilation si tu avais mis Option Explicit en haut du module.

[amouna98]

effectivement
ca marche mais j'ai un probleme:
il mouvre le 2eme fichier ( et il faut pas dans mon cas)
c'est possible

[Daniel.C]

Non, les deux fichiers doivent être ouverts. La macro ouvre le classeur cible uniquement si celui-ci est fermé.

[ZebreLoup]

Après rien ne t'empêche de le fermer à la fin de la macro. Tu vas juste avoir un problème de performance car il devra ouvrir-fermer un fichier du réseau à chaque fois que tu feras une modification.