XL 2016 VBA - Trouver les feuilles d'un classeur fermé

[Dudu2]

Bonjour,

J'ai bien une fonction pour trouver les valeurs d'une feuille donnée d'un classeur fermé (fichier joint) mais je n'ai rien pour trouver les noms des feuilles de ce classeur fermé.

Merci par avance.

 

[laurent950]

Bonjour @patricktoulon

je rends hommage à @laurent950 quand même qui est le premier a s’être lancé dans cette direction XML

Tu veux le complément "Le Code complété" ? Par contre c'est assez long en exécution !

Option Explicit

Sub FeuillesParXML_Amelioree_Test6()
    Dim chemin As String, tempZip As String, tempFolder As String
    Dim xmlPath As String
    Dim xDoc As Object, nodes As Object
    Dim i As Long, Affichage As String
    Dim objShell As Object, fso As Object, cmd As String
    Dim ext As String
   
    ' === <--- Ajuste le chemin ici
    chemin = "C:\Users\Chemins\Downloads\LeFichier.xlsx"
    ' =====================================================
   
    ext = LCase(Right$(chemin, 5))
    If ext <> ".xlsx" Then
        MsgBox "Le fichier doit être un .xlsx (format OpenXML). Extension détectée: " & ext, vbExclamation
        Exit Sub
    End If
   
    tempZip = Environ("TEMP") & "\classeur.zip"
    tempFolder = Environ("TEMP") & "\classeur_xml"
    xmlPath = tempFolder & "\xl\workbook.xml"
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    If fso.FileExists(tempZip) Then fso.DeleteFile tempZip, True
    If fso.FolderExists(tempFolder) Then fso.DeleteFolder tempFolder, True
    On Error GoTo 0
   
    ' Copier et renommer en .zip
    FileCopy chemin, tempZip
   
    ' Extraire le zip avec PowerShell — on attend la fin de l'opération
    Set objShell = CreateObject("WScript.Shell")
    cmd = "powershell -NoProfile -NonInteractive -Command ""Try { Expand-Archive -Path '" & Replace(tempZip, "'", "''") & "' -DestinationPath '" & Replace(tempFolder, "'", "''") & "' -Force } Catch { exit 1 }"""
    If objShell.Run(cmd, 0, True) <> 0 Then
        MsgBox "Erreur lors de l'extraction (PowerShell). Vérifie que PowerShell est disponible.", vbCritical
        GoTo Nettoyage
    End If
   
    If Dir(xmlPath) = "" Then
        MsgBox "workbook.xml introuvable après extraction : " & vbCrLf & xmlPath, vbExclamation
        GoTo Nettoyage
    End If
   
    ' Charger le XML et vérifier parseError
    Set xDoc = CreateObject("MSXML2.DOMDocument.6.0")
    xDoc.async = False
    xDoc.validateOnParse = False
    If Not xDoc.Load(xmlPath) Then
        MsgBox "Erreur de chargement du XML : " & xDoc.parseError.reason, vbCritical
        GoTo Nettoyage
    End If
   
    ' Mapper le namespace puis tenter la sélection des noeuds
    xDoc.SetProperty "SelectionNamespaces", "xmlns:ns='http://schemas.openxmlformats.org/spreadsheetml/2006/main'"
    Set nodes = xDoc.SelectNodes("/ns:workbook/ns:sheets/ns:sheet")
    If nodes Is Nothing Or nodes.Length = 0 Then Set nodes = xDoc.SelectNodes("//ns:sheet")
   
    If nodes Is Nothing Or nodes.Length = 0 Then
        MsgBox "Aucun noeud <sheet> trouvé dans workbook.xml. Le fichier XML peut utiliser un autre namespace ou être corrompu.", vbExclamation
        ' Afficher un aperçu du début du XML pour debug (utile pour comprendre la structure)
        Dim aperçu As String
        aperçu = Left$(xDoc.XML, 1000)
        MsgBox "Aperçu début de workbook.xml :" & vbCrLf & aperçu, vbInformation
        GoTo Nettoyage
    End If
   
    ' Construire l'affichage numéroté
    For i = 0 To nodes.Length - 1
        Affichage = Affichage & (i + 1) & " - " & nodes.Item(i).getAttribute("name") & vbCrLf
    Next i
   
    MsgBox nodes.Length & " feuille(s) trouvée(s) :" & vbCrLf & vbCrLf & Affichage, vbInformation, "Liste des feuilles"
   
Nettoyage:
    On Error Resume Next
    If Not fso Is Nothing Then
        If fso.FolderExists(tempFolder) Then fso.DeleteFolder tempFolder, True
        If fso.FileExists(tempZip) Then fso.DeleteFile tempZip, True
    End If
    On Error GoTo 0
End Sub

 

[patricktoulon]

va y @laurent950
si tu veux maintenant que le demandeur est satisfait (il a plusieurs solutions)
tu peux envoyer la sauce ,je te dirais la quantité de sel qui faut mettre 🤪

 

[laurent950]

tu peux envoyer la sauce

👉
"Hey, ce soir c’est spécial spaghettis bolognaise 🍝... appelons l’expert Power Query pour démêler tout ça 🤯. Mais attention… Power Query bien le premier, rira bien le dernier 😏😂 !"

 

[patricktoulon]

et oui c'est long c'est normal tu extrait pas que le fichier( je pense qu'on a tous abandonné powershell)
et obligé de prendre le gros lourdaud de FSO pour deleter les temporaires
je vois pas trop a quoi sert l’aperçu mais bon
travailler en xpath depuis l'ancestor a un prix aussi
xDoc.SetProperty "SelectionNamespaces", "xmlns😛refixe='http://schemas.openxmlformats.org/spreadsheetml/2006/main'"

xDoc.SelectNodes("/ns:workbook/prefixe :sheets/ns:sheet")
dans ta version tu va boucler sur les elements et leur enfants a partir du workbook( ici on est recursif)
- vs
xDoc.SelectNodes("//prefixe:sheet")
dans la mienne on prends directe les balise sheet(similaire a for each )

 

[laurent950]

et obliger de prendre le gros lourdaud de FSO pour délecter les temporaires

Oui c'était pour la forme et pour l'exercice.

 

[Cousinhub]

👉
"Hey, ce soir c’est spécial spaghettis bolognaise 🍝... appelons l’expert Power Query pour démêler tout ça 🤯. Mais attention… Power Query bien le premier, rira bien le dernier 😏😂 !"

Hello,
Comme ça?

let
    Source = Table.SelectRows(Excel.Workbook(File.Contents(NomFich), null, true), each [Kind] = "Sheet")[Name]
in
    Source

Bonne soirée

 

[patricktoulon]

et ben voila l'expert power query est arrivé sans se presser😉

 

[Cousinhub]

et ben voila l'expert power query est arrivé sans se presser😉

Hi,
Juste que "l'expert" est de trop, "utilisateur" suffira
Bonne soirée

 

[patricktoulon]

re
@Cousinhub
expert /utilisateur...
moi je suis un mangeur ou sont mes spaghettis?
Laurent viens ici!!!!je veux mes spaghettis bolo
🤣 🤣 🤣

 

[patricktoulon]

je testerais demain au boulboul
voir ce qu'on peut faire avec et tests benchmark

 

[nullosse]

Salut,
j'ai créé un classeur de test (en pièce jointe) avec des onglets qui utilisent tous les caractères valides pour les noms d'onglets.
J'ai aussi dans ce classeur, supprimé et recréé des onglets parce que dans le code de patricktoulon des versions 3 et 4 il y a
un souci pour la lecture des onglets quand ils n'ont pas une numérotation continue (des lignes vides):

code remplaçé par :

 ' Ajouter espace de noms pour les feuilles
    xDoc.SetProperty "SelectionNamespaces", "xmlns:ss='http://schemas.openxmlformats.org/spreadsheetml/2006/main'"
    ' Compter les feuilles pour redimensionner le tableau
    Dim nbFeuilles As Integer
    nbFeuilles = xDoc.SelectNodes("//ss:sheets/ss:sheet").Length
    ReDim tbl(1 To nbFeuilles)
    x = 1
    ' Parcourir les noeuds <sheet>
    For Each noeud In xDoc.SelectNodes("//ss:sheets/ss:sheet")
        tbl(x) = noeud.Attributes.getNamedItem("name").Text
        x = x + 1
    Next

En ce qui concerne les performances avec un Excel 2016 :
v1 -> 10 ms
v2 -> 70 ms
v3 -> 70 ms
v4 -> 110 ms
pour la v1 il y a un souci quand il y a un . (remplaçé par un #) ou un ! (remplacé par un _) :

D'après l'I.A c'est normal :

1. Pourquoi ça bloque ?​

Dans ACE OLEDB (et Jet avant lui) :
! est un séparateur entre table/feuille et colonne.
👉 Exemple : Feuille1!A1 → signifie "colonne A1 de Feuille1".

• . est parfois interprété comme séparateur dans les noms, surtout si la syntaxe ressemble à Table.Colonne.

Donc si ton champ ou ta feuille contient un . ou un !, ACE pense que tu veux faire une référence hiérarchique.


pour la v2 le & est remplacé par & :

Pour simplifier aussi mettre une constante public avec le nom du fichier de test plutôt que d'être obligé de changer le nom pour
chaque test :

Public Const FicTest As String = "C:\Excel\TstNomOnglets.xlsx"

Pour moi, il n'y a pas photo c'est la v1 qui est la meilleure.
Je ne joins pas le classeur avec le code modifié car je me fais crié dessus 😱 quand je publie un classeur modifié avec du code dont je ne suis pas l'auteur à l'origine.
Et pour la requête PQ de cousinhub , j'ai crée un tableau (tabWbTest) avec le nom du classeur à Tester et la requête devient :

let
    Params = Excel.CurrentWorkbook(){[Name="TabWbTest"]}[Content]{0},
    Source = Table.SelectRows(Excel.Workbook(File.Contents(Params[Classeur]), null, true), each [Kind] = "Sheet")[Name]
in
    Source

Avec ce code pour tester la performance de la requête :

Sub MesurerTempsExecutionPQ()
    Dim t0 As Double, t1 As Double
    Dim duree As Double
    ' Début du chrono
    t0 = Timer
    ' Actualisation de la requête par l'intermédiaire de la table résultat
    Worksheets("Feuil1").ListObjects("Requête1").QueryTable.Refresh BackgroundQuery:=False
    ' Fin du chrono
    t1 = Timer
    duree = t1 - t0
    MsgBox "La requête a mis " & Format(duree, "0.00") & " secondes à s'exécuter.", vbInformation
End Sub

j'obtiens entre 60 et 80 ms :

Nullosse