Modification automatique chemin d'accés de liens

Le 24/10/2016 à 21:41

Bonsoir,

j'ai fait une macro à l'aide de l'enregistreur et de mes petites connaissances afin de concaténer différentes infos de différents fichier et ça marche...

...mais uniquement si je travail là où j'ai crée la macro. Je n’arrive pas à trouver le code qui permettrait une "auto adaptation" du chemin de ma modification de lien (quand je travail sur un autre PC par exemple si je déplace mes fichiers ou dossier).

je ne sais pas si je suis très clair alors voici mon code , si d'aventures quelqu'un à une solution , je suis preneur

merci

Rv

Dim i As Integer

Dim z As Integer

Dim y As String

i = 3

y = "TOTO"

'RC

Sheets("RC MONO").Select

ChDir _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O"

ActiveWorkbook.ChangeLink Name:= _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-TATA\PPA2_2016_O\PPA2_RC_MONO_O_BA_OPTISTOCK.xlsb" _

, NewName:= _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O\PPA" & i & "_RC_MONO_O_BA_OPTISTOCK.xlsb" _

, Type:=xlExcelLinks

ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

ActiveSheet.ListObjects("TableauMONORC").Resize Range("$A$3:$AZ$" & z)

Range("A4:AZ4").Select

Selection.AutoFill Destination:=Range("TableauMONORC")

Range("A4").Select

'RC

Sheets("RC MULTI").Select

ChDir _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O"

ActiveWorkbook.ChangeLink Name:= _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-TATA\PPA2_2016_O\PPA2_RC_MULTI_O_BA_OPTISTOCK.xlsb" _

, NewName:= _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O\PPA" & i & "_RC_MULTI_O_BA_OPTISTOCK.xlsb" _

, Type:=xlExcelLinks

ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

ActiveSheet.ListObjects("TableauMULTIRC").Resize Range("$A$3:$AZ$" & z)

Range("A4:AZ4").Select

Selection.AutoFill Destination:=Range("TableauMULTIRC")

Range("A4").Select

'RR

Sheets("RR MONO").Select

ChDir _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O"

ActiveWorkbook.ChangeLink Name:= _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-TATA\PPA2_2016_O\PPA2_RR__MONO_O_BA_OPTISTOCK.xlsb" _

, NewName:= _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O\PPA" & i & "_RR__MONO_O_BA_OPTISTOCK.xlsb" _

, Type:=xlExcelLinks

ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

ActiveSheet.ListObjects("TableauMONORR").Resize Range("$A$3:$AZ$" & z)

Range("A4:AZ4").Select

Selection.AutoFill Destination:=Range("TableauMONORR")

Range("A4").Select

'RR

Sheets("RR MULTI").Select

ChDir _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O"

ActiveWorkbook.ChangeLink Name:= _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-TATA\PPA2_2016_O\PPA2_RR__MULTI_O_BA_OPTISTOCK.xlsb" _

, NewName:= _

"C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O\PPA" & i & "_RR__MULTI_O_BA_OPTISTOCK.xlsb" _

, Type:=xlExcelLinks

ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

ActiveSheet.ListObjects("TableauMULTIRR").Resize Range("$A$3:$AZ$" & z)

Range("A4:AZ4").Select

Selection.AutoFill Destination:=Range("TableauMULTIRR")

Range("A4").Select

Dim DLig As Long

Dim maLigne As Long

Sheets("RC MONO").Select

Range("TableauMONORC").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Synthése").Select

Range("A4").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

maLigne = Range("C" & Rows.Count).End(xlUp).Row + 1

Sheets("RC MULTI").Select

Range("TableauMULTIRC").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Synthése").Select

Range("A" & maLigne).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

maLigne = Range("C" & Rows.Count).End(xlUp).Row + 1

Sheets("RR MONO").Select

Range("TableauMONORR").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Synthése").Select

Range("A" & maLigne).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

maLigne = Range("C" & Rows.Count).End(xlUp).Row + 1

Sheets("RR MULTI").Select

Range("TableauMULTIRR").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Synthése").Select

Range("A" & maLigne).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("A4").Select

End Sub

Le 24/10/2016 à 22:22

Bonsoir,

en haut de la fenêtre d'édition des message il existe une barre d'outils avec un bouton [code].

Sélectionnez votre texte, cliquez sur [code] et celui-ci prend la forme d'un code VBA...

C'est plus lisible pour tous, et peut-être y aura -t-il plus de réponse...

@ bientôt

LouReeD

Le 25/10/2016 à 07:54

Bonjour,

merci , je met ça à jour 

Sub Macro1()
'
' Macro1 Macro
'

'

Dim i As Integer
Dim z As Integer
Dim y As String

i = 3
y = "TOTO"

'RC
Sheets("RC MONO").Select

    ChDir _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O"
    ActiveWorkbook.ChangeLink Name:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-TATA\PPA2_2016_O\PPA2_RC_MONO_O_BA_OPTISTOCK.xlsb" _
        , NewName:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O\PPA" & i & "_RC_MONO_O_BA_OPTISTOCK.xlsb" _
        , Type:=xlExcelLinks
    ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

    ActiveSheet.ListObjects("TableauMONORC").Resize Range("$A$3:$AZ$" & z)

    Range("A4:AZ4").Select

    Selection.AutoFill Destination:=Range("TableauMONORC")

    Range("A4").Select

'RC
Sheets("RC MULTI").Select

    ChDir _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O"
    ActiveWorkbook.ChangeLink Name:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-TATA\PPA2_2016_O\PPA2_RC_MULTI_O_BA_OPTISTOCK.xlsb" _
        , NewName:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O\PPA" & i & "_RC_MULTI_O_BA_OPTISTOCK.xlsb" _
        , Type:=xlExcelLinks
    ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

    ActiveSheet.ListObjects("TableauMULTIRC").Resize Range("$A$3:$AZ$" & z)

    Range("A4:AZ4").Select

    Selection.AutoFill Destination:=Range("TableauMULTIRC")

    Range("A4").Select

'RR
Sheets("RR MONO").Select

ChDir _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O"
    ActiveWorkbook.ChangeLink Name:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-TATA\PPA2_2016_O\PPA2_RR__MONO_O_BA_OPTISTOCK.xlsb" _
        , NewName:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O\PPA" & i & "_RR__MONO_O_BA_OPTISTOCK.xlsb" _
        , Type:=xlExcelLinks
    ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

    ActiveSheet.ListObjects("TableauMONORR").Resize Range("$A$3:$AZ$" & z)

    Range("A4:AZ4").Select

    Selection.AutoFill Destination:=Range("TableauMONORR")

    Range("A4").Select

'RR
Sheets("RR MULTI").Select

ChDir _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O"
    ActiveWorkbook.ChangeLink Name:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-TATA\PPA2_2016_O\PPA2_RR__MULTI_O_BA_OPTISTOCK.xlsb" _
        , NewName:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-" & i & "-" & y & "\PPA" & i & "_2016_O\PPA" & i & "_RR__MULTI_O_BA_OPTISTOCK.xlsb" _
        , Type:=xlExcelLinks
    ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

    ActiveSheet.ListObjects("TableauMULTIRR").Resize Range("$A$3:$AZ$" & z)

    Range("A4:AZ4").Select

    Selection.AutoFill Destination:=Range("TableauMULTIRR")

    Range("A4").Select

Dim DLig As Long

    Dim maLigne As Long

Sheets("RC MONO").Select
    Range("TableauMONORC").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Synthése").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

            maLigne = Range("C" & Rows.Count).End(xlUp).Row + 1

 Sheets("RC MULTI").Select
    Range("TableauMULTIRC").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Synthése").Select
   Range("A" & maLigne).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

             maLigne = Range("C" & Rows.Count).End(xlUp).Row + 1

Sheets("RR MONO").Select
    Range("TableauMONORR").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Synthése").Select
   Range("A" & maLigne).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

            maLigne = Range("C" & Rows.Count).End(xlUp).Row + 1

    Sheets("RR MULTI").Select
    Range("TableauMULTIRR").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Synthése").Select
   Range("A" & maLigne).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Range("A4").Select

End Sub
Le 25/10/2016 à 22:36

Bonjour,

si votre classeur se trouve dans le dossier :

C:\Users\hervé\Desktop\OptiStock Version finale iMacV7

alors pour déplacer votre fichier et que cela fonctionne encore il faut rendre le début du chemin "variable"

"variable"\OptiStock Version finale iMacV7

"variable" peut être remplacer par

Dim Le_Chemin As String
Le_Chemin = ThisWorkbook.Path
Le_Chemin = Le_Chemin & "\OptiStock Version finale iMacV7"

vous comprenez l'idée ?

@ bientôt

LouReeD

Le 25/10/2016 à 23:00

Bonsoir,

Oui je crois comprendre, j'essai demain )

Merci

Aokiba

Le 25/10/2016 à 23:13

N'hésitez pas à rendre compte, j'apprends aussi de ce coté là !

Bonne journée et bon test.

@ bientôt

LouReeD

Le 26/10/2016 à 13:50

Bonjour,

ça m'a mener sur la bonne piste ), merci

voilà au final mon code ( qui se répète car 4 fichiers dans le dossier).

Dim chemin As String
Dim i As Integer
Dim z As Integer
Dim y As String

chemin = Workbooks(ActiveWorkbook.Name).Path
i = InputBox("entrer N° de PPA")
y = InputBox("entrer clair PPA")

'RC
Sheets("RC MONO").Select

    ChDir _
        chemin
    ActiveWorkbook.ChangeLink Name:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-toto\PPA2_2016_O\PPA2_RC_MONO_O_BA_OPTISTOCK.xlsb" _
        , NewName:= _
        chemin & "\PPA" & i & "_RC_MONO_O_BA_OPTISTOCK.xlsb" _
        , Type:=xlExcelLinks
    ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

    ActiveSheet.ListObjects("TableauMONORC").Resize Range("$A$3:$BC$" & z)

    Range("A4:BC4").Select

    Selection.AutoFill Destination:=Range("TableauMONORC")

    Range("A4").Select

Mais j'ai encore un mini souci dans le redimensionnement de mes tableaux, car si le tableau du fichier à aller cehrcher ne comporte qu'une ligne, ça bloque "selection.autofil"

'RC
Sheets("RC MULTI").Select

    ChDir _
        chemin
    ActiveWorkbook.ChangeLink Name:= _
        "C:\Users\hervé\Desktop\OptiStock Version finale iMacV7\BA\PPA-2-toto\PPA2_2016_O\PPA2_RC_MULTI_O_BA_OPTISTOCK.xlsb" _
        , NewName:= _
        chemin & "\PPA" & i & "_RC_MULTI_O_BA_OPTISTOCK.xlsb" _
        , Type:=xlExcelLinks
    ActiveWindow.SmallScroll Down:=-3

z = Range("A1")

    ActiveSheet.ListObjects("TableauMULTIRC").Resize Range("$A$3:$BC$" & z)

    Range("A4:BC4").Select

    Selection.AutoFill Destination:=Range("TableauMULTIRC")

    Range("A4").Select
Le 26/10/2016 à 17:41

Bonsoir,

un :

Range("A4:BC4").Select
Selection.AutoFill Destination:=Range("$A$3:$BC$" & z)

Est-ce que cela fonctionne ?

@ bientôt

LouReeD

Le 03/11/2016 à 21:36

J'aurais tendance à dire que oui...

@ bientôt

LouReeD

Rechercher des sujets similaires à "modification automatique chemin acces liens"