Macro Excel pour ouvrir des fichiers dans une liste

Le 18/09/2013 à 11:24

Bonjour,

J'ai besoin de votre aide pour trouver le code d'une macro que je souhaite faire.

Dans un fichier central, j'ai saisi dans une plage de données (par exemple la plage A1:B20) le nom de plusieurs fichiers Excel et leurs liens hypertexte pouvant les ouvrir lorsque l'on clique dessus.

Je souhaite développer une macro qui pourra faire les actions suivantes pour chaque lien hypertexte contenu dans la plage B1:B20 :

  • Ouvrir le fichier en question via le lien hypertexte
  • Copier une feuille de ce fichier
  • La coller (collage spécial, valeur et format) dans le fichier central
  • Fermer le fichier d'où a été copiée la feuille en question
  • Passer au fichier suivant contenu dans la plage de données B1:B20 du fichier central (une boucle devrait théoriquement faire l'affaire).
J'ai des connaissances très limitées en vba et n'ai pas réussi à trouver la solution à mon problème sur les forums d'aide.

Vous serait-il possible de m'aider à ce sujet ?

Merci d'avance

Le 18/09/2013 à 13:28

Salut,

Appelle "Feuil1" l'onglet dans lequel va se trouver ta liste d'hyperliens.

Etablis ta liste d'hyperliens à partir de la cellule A1 vers le bas.

clique droit sur l'onglet "Feuil1" et sélectionne "Visualiser le code".

colle ce code dans la fenêtre qui s'ouvre

Sub try()
Dim wbS As Workbook, wbC As Workbook
Dim c As Long
Dim aa As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbC = ThisWorkbook
With Sheets("Feuil1")
c = 1
Do Until IsEmpty(.Cells(c, 1))
If shControl(.Cells(c, 1).Value) = False Then
    If .Cells(c, 1).Hyperlinks.Count = 1 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        aa = .Cells(c, 1).Value
        ActiveSheet.Name = aa
        .Cells(c, 1).Hyperlinks(1).Follow
        Set wbS = ActiveWorkbook
        wbS.Sheets(1).Cells.Copy wbC.Sheets(aa).Cells(1)
        wbS.Close
    End If
End If
c = c + 1
Loop

End With
Application.DisplayAlerts = True
End Sub
Function shControl(aa As String) As Boolean
On Error Resume Next
shControl = Sheets(aa).Name <> ""
On Error GoTo 0
End Function

lance la macro en appuyant sur la touche F5 - la macro copie la première feuille de chaque fichier ouvert par les hyperliens dans le fichier Cible.

Le 18/09/2013 à 13:45

Merci infiniment Game over,

Je viens de suivre tes recommandations. J'ai crée un bouton et lui ai affecté la macro try. Lorsque je clique sur le bouton, cela m'affiche "Erreur 400" et une feuille additionnelle vide est créée dans le classeur en question.

Je joins le fichier à toute fin utile.

Aurais-tu une explication à cette erreur stp ?

Dans le même esprit (j'espère que je n'abuse pas ), serait-il possible que le contenu de la feuille de chaque fichier dont le chemin est indiqué via la lien hypertexte soit collé dans la feuille qui portera le nom du fichier en question et ce dans le classeur central (où se trouve la macro ) ?

Merci encore

87test-macro-reporting.xlsm (18.12 Ko)
Le 18/09/2013 à 13:57
YoBoB a écrit :

Lorsque je clique sur le bouton, cela m'affiche "Erreur 400" et une feuille additionnelle vide est créée dans le classeur en question.

C'est surement parce que le nom qui est affecté à l'onglet créé est la valeur de la cellule : or, tu as mis le chemin complet dans la cellule; la chaine de caractères est trop longue pour être contenue dans l'onglet.

tu vas devoir raccourcir le le contenu de ta cellule; par exemple la cellule A1 devra avoir la valeur "Skhirat.xlsb"

vois si ça marche

Le 18/09/2013 à 14:29

Waou, c'est puissant ! Bravo Monsieur !

ça marche bien sauf que le contenu qui est collé dans le fichier central correspond à l'ensemble des données des classeurs sources (par exemple skhirat.xlsb) . En fait, je souhaite uniquement copier un tableau qui figure dans la feuille "synthèse" qui se trouve dans chacun des classeurs sources dont je dispose. Le collage doit :

1. être un collage spécial "en valeur puis en format" et

2. Le contenu (dans la limite du possible) doit être copié dans la feuille vide existante qui porte le nom du fichier (par exemple, pour la feuille synthèse du fichier "skhirat.xlsb", le contenu doit être copié dans la feuille skhirat qui sera vide avant l'exécution de la macro et qui figurera dans le fichier central).

Aurais-tu stp une piste pour répondre à ces deux points ?

Tu me sauves vraiment !!!!

Le 18/09/2013 à 15:03
YoBoB a écrit :

Waou, c'est puissant ! Bravo Monsieur !

sauf que le contenu qui est collé dans le fichier central correspond à l'ensemble des données des classeurs sources (par exemple skhirat.xlsb) . En fait, je souhaite uniquement copier un tableau qui figure dans la feuille "synthèse" qui se trouve dans chacun des classeurs sources dont je dispose.

La macro fait ce que tu as demandé dans ton premier post !

YoBoB a écrit :

Je souhaite développer une macro qui pourra faire les actions suivantes pour chaque lien hypertexte contenu dans la plage B1:B20 :

  • Ouvrir le fichier en question via le lien hypertexte
  • Copier une feuille de ce fichier
  • La coller (collage spécial, valeur et format) dans le fichier central

Ici, il ne s'agissait nullement de copier une partie de la feuille mais la feuille entière.

Vu que tu ne me dis pas où se trouve ton tableau à copier dans la feuille "synthèse", celui-ci doit commencer dans la cellule A1 pour chacun de tes fichiers.

toutes les cellules adjacentes à ton tableau doivent être vides.

Ton lien hypertexte ne doit contenir que le nom du fichier sans extention.

La macro crée et renomme les onglets de ton fichier cible (central) automatiquement.

L'adresse du lien hypertexte apparait dans la cellule A1 de chaque onglet

Sub try()
Dim wbS As Workbook, wbC As Workbook
Dim c As Long
Dim aa As String

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
End With

Set wbC = ThisWorkbook
With Sheets("Feuil1")
c = 1
Do Until IsEmpty(.Cells(c, 1))
If shControl(.Cells(c, 1).Value) = False Then
    If .Cells(c, 1).Hyperlinks.Count = 1 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        aa = .Cells(c, 1).Value
        ActiveSheet.Name = aa
        .Cells(c, 1).Hyperlinks(1).Follow
        zz = .Cells(c, 1).Hyperlinks(1).Address
        Set wbS = ActiveWorkbook
        wbS.Sheets("synthèse").Cells(1).CurrentRegion.Copy
        wbC.Sheets(aa).Range("A2").PasteSpecial Paste:=xlPasteValues
        wbC.Sheets(aa).Range("A2").PasteSpecial Paste:=xlPasteFormats
        wbC.Sheets(aa).Cells(1) = zz
        wbS.Close
    End If
End If
c = c + 1
Loop

End With
With Application
    .DisplayAlerts = True
    .EnableEvents = True
    .CutCopyMode = False
End With
End Sub
Function shControl(aa As String) As Boolean
On Error Resume Next
shControl = Sheets(aa).Name <> ""
On Error GoTo 0
End Function

code non testé car je n'ai pas tes fichiers "synthèse"

Le 18/09/2013 à 15:23

Oui désolé, effectivement je n'avais pas bien précisé les choses dans mon poste

En gros, le tableau figurant des les feuilles "Synthèse" se trouve dans la plage "A2 : BD1700". J'aimerai que ce contenu soit collé "en valeur et en format" dans les feuilles portant le nom des fichiers sources (idéalement à partir de la ligne n°5. Serait-il possible de le faire ?

Désolé encore

Le 18/09/2013 à 15:28

essaye ça

Sub try()
Dim wbS As Workbook, wbC As Workbook
Dim c As Long
Dim aa As String

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
End With

Set wbC = ThisWorkbook
With Sheets("Feuil1")
c = 1
Do Until IsEmpty(.Cells(c, 1))
If shControl(.Cells(c, 1).Value) = False Then
    If .Cells(c, 1).Hyperlinks.Count = 1 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        aa = .Cells(c, 1).Value
        ActiveSheet.Name = aa
        .Cells(c, 1).Hyperlinks(1).Follow
        zz = .Cells(c, 1).Hyperlinks(1).Address
        Set wbS = ActiveWorkbook
        wbS.Sheets("synthèse").Range("A2").CurrentRegion.Copy
        wbC.Sheets(aa).Range("A5").PasteSpecial Paste:=xlPasteValues
        wbC.Sheets(aa).Range("A5").PasteSpecial Paste:=xlPasteFormats
        wbC.Sheets(aa).Cells(1) = zz
        wbS.Close
    End If
End If
c = c + 1
Loop

End With
With Application
    .DisplayAlerts = True
    .EnableEvents = True
    .CutCopyMode = False
End With
End Sub
Function shControl(aa As String) As Boolean
On Error Resume Next
shControl = Sheets(aa).Name <> ""
On Error GoTo 0
End Function
Le 18/09/2013 à 15:46

Je viens d'essayer la macro.

Le contenu est bien copié à partir de la ligne n°5 du fichier central. Par contre, il n'y a que les les 4 premières lignes du tableau de la feuille "Synthèse" qui sont collées. La tableau s'étend sur la plage "A2:BD1700" des feuilles "synthèse".

Y aurait-il un moyen d'y remédier stp ?

et désolé d'avoir abusé

Le 18/09/2013 à 15:47

J'ai besoin de ton fichier

Le 18/09/2013 à 16:09

Merci de trouver ci-joint :

Le fichier central où se trouve la macro "Test macro reporting v2.xlsm"

Le fichier "Skhirat.xlsb" pour l'exemple de la feuille "Synthèse" à importer. La zone à copier est sélectionnée dans la feuille en question

Remarque : serait-il possible que le contenu de la feuille "Skhirat.xlsb" soit copié dans la feuille vide "Skhirat" du classeur "Test marcro reporting v2.xlsm" ?

Merci encore

Le fichier "Skhirat.xlsb" est trop gros. J'ai réduit la plage des cellules à copier pour l'exemple (plage "A3:BD56")

Merci

J'ai encore réduis la taille de la plage à copier (A3:T23)

36test-macro-reporting-v2.xlsm (22.09 Ko)
32skhirat.xlsb (216.73 Ko)
Le 18/09/2013 à 16:18

Tes feuilles de synthèse ne contiennent que les titres...

difficile de travailler dans de telles conditions.

Tes tableaux ne devraient pas contenir de ligne vide, cela résoudra peut être ton problème.

De plus, je t'ai dit qu'il était inutile de créer les onglets dans ton fichier Cible car la macro le faisait déjà pour toi.

Voilà tout ce que je peux faire en l'état.

Le 18/09/2013 à 16:23

Pourtant il y a un tableau dans la feuille "Synthèse". Ne serait-il pas possible d'indiquer dans la macro la plage à copier pour que tout le tableau soit repris ?

Pour les onglets, c'est pas très grave, c'est un souci mineur

Merci

Le 18/09/2013 à 16:32
YoBoB a écrit :

Ne serait-il pas possible d'indiquer dans la macro la plage à copier pour que tout le tableau soit repris ?

c'est parfaitement possible, mais tu travailles sur un tableau statique... le nombre de lignes et de colonnes ne devra pas changer.

voici le code :

Sub try()
Dim wbS As Workbook, wbC As Workbook
Dim c As Long
Dim aa As String

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
End With

Set wbC = ThisWorkbook
With Sheets("Feuil1")
c = 1
Do Until IsEmpty(.Cells(c, 1))
If shControl(.Cells(c, 1).Value) = False Then
    If .Cells(c, 1).Hyperlinks.Count = 1 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        aa = .Cells(c, 1).Value
        ActiveSheet.Name = aa
        .Cells(c, 1).Hyperlinks(1).Follow
        zz = .Cells(c, 1).Hyperlinks(1).Address
        Set wbS = ActiveWorkbook
        wbS.Sheets("synthèse").Range("A2").CurrentRegion.Copy
        wbC.Sheets(aa).Range("A2:BD1700").PasteSpecial Paste:=xlPasteValues
        wbC.Sheets(aa).Range("A2:BD1700").PasteSpecial Paste:=xlPasteFormats
        wbC.Sheets(aa).Cells(1) = zz
        wbS.Close
    End If
End If
c = c + 1
Loop

End With
With Application
    .DisplayAlerts = True
    .EnableEvents = True
    .CutCopyMode = False
End With
End Sub
Function shControl(aa As String) As Boolean
On Error Resume Next
shControl = Sheets(aa).Name <> ""
On Error GoTo 0
End Function
Le 18/09/2013 à 16:45

Je viens de tester la macro. Voici le résultat que ça me donne. Je ne retrouve pas le tableau mais uniquement les 4 premières lignes (effectivement, tous les tableaux des feuilles "Synthèse" auront le même nombre de lignes et de colonnes).

Désolé de t'avoir trop embêté avec mon problème, je vais arrêter.

Ravi d'avoir fait ta connaissance et merci pour tout

40test-macro-reporting-v2.xlsm (223.67 Ko)
Le 18/09/2013 à 18:10

tant que je n'aurais pas un fichier synthèse original, je ne pourrai pas t'aider plus que ça.

Le 18/09/2013 à 21:52

ça devrait marcher comme ça

    Sub try()
    Dim wbS As Workbook, wbC As Workbook
    Dim c As Long
    Dim aa As String

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    Set wbC = ThisWorkbook
    With Sheets("Feuil1")
    c = 1
    Do Until IsEmpty(.Cells(c, 1))
    If shControl(.Cells(c, 1).Value) = False Then
        If .Cells(c, 1).Hyperlinks.Count = 1 Then
            Sheets.Add after:=Sheets(Sheets.Count)
            aa = .Cells(c, 1).Value
            ActiveSheet.Name = aa
            .Cells(c, 1).Hyperlinks(1).Follow
            zz = .Cells(c, 1).Hyperlinks(1).Address
            Set wbS = ActiveWorkbook
            wbS.Sheets("synthèse").Range("A2:BD1700").Copy
            wbC.Sheets(aa).Range("A2:BD1700").PasteSpecial Paste:=xlPasteValues
            wbC.Sheets(aa).Range("A2:BD1700").PasteSpecial Paste:=xlPasteFormats
            wbC.Sheets(aa).Cells(1) = zz
            wbS.Close
        End If
    End If
    c = c + 1
    Loop

    End With
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .CutCopyMode = False
    End With
    End Sub
    Function shControl(aa As String) As Boolean
    On Error Resume Next
    shControl = Sheets(aa).Name <> ""
    On Error GoTo 0
    End Function
Rechercher des sujets similaires à "macro ouvrir fichiers liste"