Discussion :

[JasonVENOT]

Bonjour à tous,

Après 2 jours de recherches sur plusieurs forum je viens poster ma première demande d'aide.

Explications :

Je dois importer (copier/coller) des feuilles de 44 classeurs et les mettre dans un seul. Ils sont regroupés dans un seul dossier.
Ils ont tous le même nombre de feuilles et la même organisation.
ordre: "Suvi SSt..." "VIEW" "DATA" seul la feuille "VIEW" sera visé.

Mon ficher récepteur "classeur1" contient 3 fichiers
"Lancement" : où se trouve un bouton (avec macros) qui copie l'intitulé et trie les 44 fichiers contenu dans le dossier dans une feuille portant le nom du dossier.

"Nom du dossier" (pour l'exemple : Liste fichiers GTC 12-dec) : Contient les liens HyperTexte des excels où je dois récupérer les feuilles VIEW.

"Récapitulatif" une autre feuille qui prendra les données des futurs feuilles VIEW


Voilà mon problème :

Je n'arrive pas à créer une boucle permettant
- d'ouvrir dans l'ordre les liens hypertext (qui donne chacun lieu à un classeur excel) présents dans la feuille "Liste fichiers GTC 12-dec",

- copié la feuille "VIEW" suite à l'ouverture du fichier excel,

- créer une nouvelle feuille dans classeur1

- la coller dans mon classeur1

- Donné le nom de la feuille créer (dans classeur1) une cellule la feuille VIEW collé (qui en plus dépasse 31 caractères)

et bien sûr répéter l'action pour tous les liens hypertext !
(J'avais oublier, refermer les 44 classeurs aussi après qu'on ai copié la feuille VIEW)

Ci-joint le code de mon bouton permettant de Lister et trier dans l'ordre alphabétique les fichiers du dossier en ajoutant les liens HT. (à titre informatif car le nom de la feuille créer prend en parti le texte d'une cellule)

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Sub etape_une()
    On Error GoTo Mauvais_dossier
 
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Liste fichiers GTC " & Worksheets("Lancement").[B2]
 
    Dim Dossier As String
 
    'Définit le répertoire pour débuter la recherche de fichiers.
    '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
    'fichiers, sinon le temps de traitement va être très long).
    Dossier = "\\srvlx3\otcelr\ressources-communes\04-Echange\JASON\Macro\Données\" & Worksheets("Lancement").[B2]
 
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
 
    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
    Columns("A:E").AutoFit
    MsgBox "Liste des fichiers triés par Sous Station pour le mois " & Worksheets("Lancement").[B2] & vbNewLine & "Appuyer sur le 2ème bouton pour récolter les données"
 
 
    Exit Sub
 
Mauvais_dossier: 'étiquette
    MsgBox "Le dossier " & Worksheets("Lancement").[B2] & " n'éxiste pas" & vbNewLine & "Voir arborescence du dossier"
 
End Sub
 
Sub ListeFichiers(Repertoire As String)
 
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cluquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
 
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
 
 
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("A65536").End(xlUp).Row + 1
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 2) = FileItem.DateCreated
        'Indique la date de dernier acces
        Cells(i, 3) = FileItem.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 4) = FileItem.DateLastModified
        'Nom du répertoire
        Cells(i, 5) = FileItem.ParentFolder
 
        i = i + 1
    Next FileItem
 
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoire ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
    Range("A1:Z1000").Sort Key1:=Range("A1"), Order1:=xlAscending
 
 
End Sub

Et voici ce que j'ai essayer pour mon problème :

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
Sub ActiverLiens()
Application.ScreenUpdating = False
  For Each HL In Sheets("Feuil1").Hyperlinks
    Sheets("VIEW").Select
    Sheets("VIEW").Copy After:=Sheets(4)
    HL.Follow
    Next
Application.DisplayAlerts = False
For Each classeur In Workbooks
If classeur.Name <> ThisWorkbook.Name Then
classeur.Save
classeur.Close
End If
Next classeur
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Ce code ne marche pas

Si il y a des courageux ! Merci d'avance pour votre retour et n'hésitez pas à me signaler si vous avez besoin de plus d'information.

Avez-vous besoin des excels ?
Je mets en pièce jointe mon "classeur1.xlsm" et un exemple de fichier comportant les données



Merci encore !

[JasonVENOT]

Ok, j'ai réussi à avancer en repartant depuis le début,

J'arrive a ouvrir le lien via la feuille et copier/coller la feuille direct dans le "classeur1".

Seul problème je n'ai aucune valeur...
Un indice ?

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
Sub ActiverLiens()
Application.ScreenUpdating = True
  For Each HL In Sheets("Feuil1").Hyperlinks
    HL.Follow
    ActiveWindow.View = xlNormalView
    Sheets("VIEW").Move After:=Workbooks("Classeur1.xlsm").Sheets(4)
 
    Next
Application.DisplayAlerts = False
 
For Each classeur In Workbooks
If classeur.Name <> ThisWorkbook.Name Then
classeur.Close False
End If
Next classeur
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Merci !