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.

 

[kiki29]

Salut, si curieux voir pj

 

[patricktoulon]

Bonsoir kiki29
merci pour ce complément bon memo pour le getobject

je trouve cependant dommage qu'il ne soit pas abordée dans ce tuto pour les declaration d'object
la methode avec les CLISD
je donne donc un peu de renseignement en plus
de certains que j'utilise sur des pc mal fagotés

'DataObject MSForms ou MSForms.DataObject
    set obj= CreateObject("Forms.DataObject")
    set obj= CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

'FileSystemObject
    set obj= CreateObject("Scripting.FileSystemObject")
    set obj= CreateObject("New:{0D43FE01-F093-11CF-8940-00A0C9054228}")

'Dictionary
    set obj= CreateObject("Scripting.Dictionary")
    set obj= CreateObject("New:{EE09B103-97E0-11CF-978F-00A02463E06F}")

'WScript.Shell
    set obj= CreateObject("WScript.Shell")
    set obj= CreateObject("New:{72C24DD5-D70A-438B-8A42-98424B88AFB8}")

'WScript.Network
    set obj= CreateObject("WScript.Network")
    set obj= CreateObject("New:{093FF999-1EA0-4079-9525-9614C3504B74}")

'Internet Explorer
    set obj= CreateObject("InternetExplorer.Application")
    set obj= CreateObject("New:{0002DF01-0000-0000-C000-000000000046}")

'Dom documentHTML
    set obj= CreateObject("htmlfile")
    set obj= CreateObject("New:{25336920-03F9-11CF-8FD0-00AA00686F13}")

'ADODB.Connection
    set obj= CreateObject("ADODB.Connection")
    set obj= CreateObject("New:{00000514-0000-0010-8000-00AA006D2EA4}")

'ADODB.Recordset
    set obj= CreateObject("ADODB.Recordset")
    set obj= CreateObject("New:{00000535-0000-0010-8000-00AA006D2EA4}")

'ADODB.Stream
    set obj= CreateObject("ADODB.Stream")
    set obj= CreateObject("New:{00000566-0000-0010-8000-00AA006D2EA4}")

'MSXML DOM (6.0)
    set obj= CreateObject("MSXML2.DOMDocument.6.0")
    set obj= CreateObject("New:{88D96A05-F192-11D4-A65F-0040963251E5}")

'MSXML HTTP (6.0)
    set obj= CreateObject("MSXML2.XMLHTTP.6.0")
    set obj= CreateObject("New:{88D96A0A-F192-11D4-A65F-0040963251E5}")

'Excel.Application
    set obj= CreateObject("Excel.Application")
    set obj= CreateObject("New:{00024500-0000-0000-C000-000000000046}")

'Word.Application
    set obj= CreateObject("Word.Application")
    set obj= CreateObject("New:{000209FF-0000-0000-C000-000000000046}")

'Outlook.Application
    set obj= CreateObject("Outlook.Application")
    set obj= CreateObject("New:{0006F03A-0000-0000-C000-000000000046}")

'PowerPoint.Application
    set obj= CreateObject("PowerPoint.Application")
    set obj= CreateObject("New:{91493441-5A91-11CF-8700-00AA0060263B}")

'Access.Application
    set obj= CreateObject("Access.Application")
    set obj= CreateObject("New:{73FDDC80-AEA9-101A-98A7-00AA00374959}")

 

[Dudu2]

J'ai finalement mis la V5 en solution et sous format texte telle que je la conserverai en Post 83.

 

[patricktoulon]

re
tenez je vous ai fait un petit tableau pour les declaration et instanciation de ces object avec les deux late binding progID et CLISD dans un pdf
ca mange pas de pain à consulter sans modération au besoins

 

[patricktoulon]

@Dudu2 si on met les replace sous condition d'occurence on gagne environ 30 ms

Sub testv7()
    Dim bm As New cBenchmark
    Debug.Print "Test de : ListfeuilleXmlTarV5 avec Tar+ split stdout.readal + Ansi to utf-8"
    xlsxPath = "C:\Users\patricktoulon\Desktop\Classeur1.xlsx"
    bm.TrackByName "debut ListfeuilleXmlTarV5 avec Tar+ split stdout.readal + Ansi to utf-8"
    x = ListfeuilleXmlTarV5(xlsxPath)
    bm.TrackByName "fin ListfeuilleXmlTarV5 avec Tar+ split stdout.readal + Ansi to utf-8"
    
    MsgBox Join(x, vbCrLf)
End Sub

Function ListfeuilleXmlTarV5(xlsxPath)
    Dim cmd As String, codxml As String
    Dim streamAnsi As Object, streamUtf8 As Object
    
    ' Commande tar pour extraire le XML directement vers StdOut
    cmd = "cmd /c tar -xOf """ & xlsxPath & """ xl/workbook.xml"
    
    'execution de la ligne de commande avec wscrip.shell mais cette fois si avec exec et non run
    'car il nous faut le stdout.readall directe sans passer par l'object clipboard
    With CreateObject("WScript.Shell")
        codxml = .exec(cmd).StdOut.ReadAll
    End With
    'les caractères echapés
    If codxml Like "*&*" Then codxml = Replace(codxml, "&", "&")
    If codxml Like "*&lt;*" Then codxml = Replace(codxml, "&lt;", "<")
    If codxml Like "*&gt;*" Then codxml = Replace(codxml, "&gt;", ">")
    If codxml Like "*&quot;*" Then codxml = Replace(codxml, "&quot;", """")
    If codxml Like "*&apos;*" Then codxml = Replace(codxml, "&apos;", "'")
    'ajouter des eventuels replace que je n'ai pas vu ou testé
    'codxml = Replace(codxml,"blablabla","trucbidule")
 
    'format Ansi on l'ecrit comme il est même si c'est pas bon en Ansi
    'car extraction par le redall est en Ansi
    Set streamAnsi = CreateObject("ADODB.Stream")
    With streamAnsi
        .Type = 2: .Charset = "windows-1252": .Open: .WriteText codxml: .Position = 0: .Type = 1
    End With
    
    'format UTF-8
    'on copie le streamAnsi dans le streamUTF8 mais on l'encode avec utf-8
    Set streamUtf8 = CreateObject("ADODB.Stream")
    With streamUtf8
        .Type = 1: .Open: streamAnsi.CopyTo streamUtf8: .Position = 0: .Type = 2: .Charset = "utf-8"
        xmlContent = .ReadText
    End With
    'fermeture des streamer
    streamAnsi.Close: streamUtf8.Close
    
    'on prend les même et on recommence
    t = Split(xmlContent, "<sheet name=""") 'on coupe le texte par les ouvertures de balise "sheet"
    ReDim tx(1 To UBound(t) + 1) 'on dimentionne un tablkeau de même taile que le split EN BASE 1!!!!!
    For i = 1 To UBound(t)
        tx(i) = Split(t(i), """")(0) 'on prends que la partie qui nous interesse donc ni plus ni moins que l'attribut name
          Next
    ListfeuilleXmlTarV5 = tx 'le return c'est le tableau tx
    
End Function

les replace c'est pour la caractères échapés
les autres caractères ",;:!// etc... sont parfaitement reconverti par le bypass avec les deux streamer

on retiendra dans cette version la récupération facile du contenu du xml

  codxml = .exec(cmd).StdOut.ReadAll

parfois je suis comme un diezel
ça démarre doucement et après ca bombarde 😉 😉

je met tout ça au propre et refait les tests benchmark bien que je me doute avec les replace l'ordre va être différent

patrick

 

[patricktoulon]

et voici les resultats finaux

Test de : ListSheetOnClosedFile avec ADO
IDnr  Name                                   Count  Sum of tics  Percentage  Time sum
0     debut ListSheetOnClosedFile avec ADO       1          142       0,02%     14 us
1     fin ListSheetOnClosedFile avec ADO         1      813 757      99,98%     81 ms
      TOTAL                                      2      813 899     100,00%     81 ms

Total time recorded:             81 ms

Test de : ListfeuilleXmlTarV1 avec Tar+ split
IDnr  Name                       Count  Sum of tics  Percentage  Time sum
0     debut ListfeuilleXmlTarV1      1          125       0,01%     12 us
1     fin ListfeuilleXmlTarV1        1    1 104 743      99,99%    110 ms
      TOTAL                          2    1 104 868     100,00%    110 ms

Total time recorded:             110 ms

Test de : ListfeuilleXmlTarV2 Tar+parser dom
IDnr  Name                       Count  Sum of tics  Percentage  Time sum
0     debut ListfeuilleXmlTarV2      1          126       0,01%     13 us
1     fin ListfeuilleXmlTarV2        1      989 173      99,99%     99 ms
      TOTAL                          2      989 299     100,00%     99 ms

Total time recorded:             99 ms

Test de : ListfeuilleXmlTarV3 avec Tar+ split intra clipboard
IDnr  Name                                                     Count  Sum of tics  Percentage  Time sum
0     debut ListfeuilleXmlTarV3                                    1          128       0,01%     13 us
1     fin ListfeuilleXmlTarV3 avec Tar+ split intra clipboard      1    1 142 706      99,99%    114 ms
      TOTAL                                                        2    1 142 834     100,00%    114 ms

Total time recorded:             114 ms

Test de : ListfeuilleXmlTarV5 avec Tar+ split stdout.readal + Ansi to utf-8
IDnr  Name                                                                     Count  Sum of tics  Percentage  Time sum
0     debut ListfeuilleXmlTarV5 avec Tar+ split stdout.readal + Ansi to utf-8      1          122       0,01%     12 us
1     fin ListfeuilleXmlTarV5 avec Tar+ split stdout.readal + Ansi to utf-8        1    1 536 717      99,99%    154 ms
      TOTAL                                                                        2    1 536 839     100,00%    154 ms

Total time recorded:             154 ms

Test de : ListSheetOnClosedFileXML avec shell.automation
IDnr  Name                            Count  Sum of tics  Percentage  Time sum
0     debut ListSheetOnClosedFileXML      1          120       0,01%     12 us
1     fin ListSheetOnClosedFileXML        1    1 535 167      99,99%    154 ms
      TOTAL                               2    1 535 287     100,00%    154 ms

Total time recorded:             154 ms

il est clairs que ADO reprends le dessus mais perd des caractères ou les remplace (je n'ai pas fait les replace pour ADO
plus on va vers le fini plus ca monte

il y a les avantages et inconvenients
la v 5 effectivement 154 ms mais complément fini
sachant que j'ai testé un classeur de 150 feuilles (oui je sais c'est absurde)

 

[patricktoulon]

et pour conclure mon cher @Dudu2 voici la classe cbenchmark avec les dico en latebing
tu n'aura plus la ref à activer
remplace ".txt "par ".cls"
à garder soigneusement cette fois ci hein 🤓

 

[nullosse]

Salut,
dommage ! la proposition de dysorthographie d'utiliser ADOX n'a pas été prise en compte et pourtant elle fonctionne. Voici un code qui l'utilise :

Sub ListExcelSheetNames()
    Dim cat As Object, tbl As Object ' ADOX
    Dim cn As Object ' ADODB.Connection
    Dim filePath As Variant, connStr As String, bm As New cBenchmark
    filePath = Application.GetOpenFilename("excel Files (*.xls*), *.xls*", 1, "ouvrir un fichier Excel")
    If filePath = False Then Exit Sub
    bm.Start
    ' Use ACE OLEDB for .xlsx
    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & filePath & ";" & _
              "Extended Properties=""Excel 12.0 Xml;HDR=Yes"";"
    ' Create ADOX Catalog
    Set cn = CreateObject("ADODB.Connection")
    cn.Open connStr
    Set cat = CreateObject("ADOX.Catalog")
    Set cat.ActiveConnection = cn
    ' Loop through tables (sheets)
    For Each tbl In cat.Tables
        outStr = outStr & Replace(Replace(tbl.Name, "$", ""), "'", "") & vbCrLf
    Next
    bm.TrackByName "ADOX"
    Debug.Print outStr
    ' Cleanup
    cn.Close
    Set cat = Nothing: Set cn = Nothing
End Sub

En ce qui concerne les substitutions de caractères voilà ce que chatGPT préconise pour les noms de Feuille :

Voici la liste complète des caractères interdits dans les noms de feuille Excel, ainsi que quelques règles importantes à connaître :

---

Caractères interdits​

Vous ne pouvez pas utiliser les caractères suivants dans un nom de feuille :

: \ / ? * [ ]

• Ces caractères provoquent une erreur si vous essayez de les inclure.
• Excel ne remplace pas automatiquement ces caractères ; il empêche simplement leur saisie.

---

Autres restrictions​

1. Longueur maximale : 31 caractères.
2. Nom vide : impossible de laisser le nom vide.
3. Noms réservés : History ou certains noms système peuvent être interdits dans certaines versions d’Excel.
4. Début et fin : pas d’espace au début ou à la fin (ils sont automatiquement supprimés).
5. Caractères spéciaux autorisés mais à manipuler avec prudence:
   • . (point), ! (point d’exclamation) sont autorisés, mais peuvent poser problème si on fait référence aux feuilles dans des formules ou via ADO/OLEDB.
   • Les accents et caractères Unicode sont généralement acceptés.

comme on peut le constater le . et le ! dans les noms de feuille sont déconseillés.

Nullosse.

 

[Dudu2]

Bonjour à tous,
@nullosse, ce code ne fonctionne pas correctement au moins pour "." et "!".
Alors je sais bien qu'on ne trouve pas ces 2 caractères communément dans des noms de feuilles mais à partir du moment où c'est possible, le code doit le supporter.

Edit: en Post #123 l'expert ADO @dysorthographie semble confirmer qu'il n'y pas de solution si je l'ai bien compris.

 

[nullosse]

Salut Dudu2,
Si quelqu'un utilise le . et le ! dans ses noms de feuilles il s'expose à des erreurs en particulier si il y a des formules entre feuilles.
N'importe comment il n'y a pas plantage si il y a des . ou des ! dans les noms de feuilles il y a substitution (# pour . et _ pour !)
et que donne chez toi le benchmark sur la fonction avec ADOX ? (la première fois c'est toujours plus lent)
et comment vas-tu exploiter les noms de feuilles ? but ?

 

[patricktoulon]

bonjour
rapport sur Adox
1er lancement 175ms
2d lancement 25ms
on est pas mal, il faut voir avec les replaces

 

[Dudu2]

J'exploite le nom des feuilles pour lire le contenu (UsedRange) des feuilles en ADO (de classeurs fermés) afin d'en analyser le contenu et extraire des éléments identifiés par des Tags. Dans le fichier joint qui m'a servi de test de base, j'utilise encore la méthode de @dysorthographie.
Si le nom des feuilles n'était pas correct je pense que l'extraction planterait (à vérifier).

Pour le Benchmark de ton dernier code ça donne ça (3 exécutions, liste inverse du Debug.Print))

IDnr Name Count Sum of tics Percentage Time sum
0 ADOX 1 431 673 100,00% 43 ms
TOTAL 1 431 673 100,00% 43 ms

Total time recorded: 43 ms

IDnr Name Count Sum of tics Percentage Time sum
0 ADOX 1 363 492 100,00% 36 ms
TOTAL 1 363 492 100,00% 36 ms

Total time recorded: 36 ms

IDnr Name Count Sum of tics Percentage Time sum
0 ADOX 1 949 544 100,00% 95 ms
TOTAL 1 949 544 100,00% 95 ms

Total time recorded: 95 ms

 

[patricktoulon]

Bonjour
ils sont bizarre tes resultats @Dudu2
chez moi ça va en descendant
1 er lancement 175
2d lancement 26
3eme lancement 16 ms
et cela même avec les replace

Sub ListExcelSheetNames()
    Dim cat As Object, tbl As Object ' ADOX
    Dim cn As Object ' ADODB.Connection
    Dim filePath As Variant, connStr As String, bm As New cBenchmark
    filePath = Application.GetOpenFilename("excel Files (*.xls*), *.xls*", 1, "ouvrir un fichier Excel")
    If filePath = False Then Exit Sub
    bm.Start
    ' Use ACE OLEDB for .xlsx
    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & filePath & ";" & _
              "Extended Properties=""Excel 12.0 Xml;HDR=Yes"";"
    ' Create ADOX Catalog
    Set cn = CreateObject("ADODB.Connection")
    cn.Open connStr
    Set cat = CreateObject("ADOX.Catalog")
    Set cat.ActiveConnection = cn
    ' Loop through tables (sheets)
    For Each tbl In cat.Tables
        n = Replace(tbl.name, "_", "!")
        n = Replace(n, "#", ".")
        outStr = outStr & Replace(Replace(n, "$", ""), "'", "") & vbCrLf
    Next
    bm.TrackByName "ADOX"
    Debug.Print outStr
    ' Cleanup
    cn.Close
    Set cat = Nothing: Set cn = Nothing
End Sub

j'ai refermé le classeur et ré ouvert plusieurs fois
le premier lancement reste dans des temps entre 15 et 20
ca veux dire que si adodb a été ouvert une fois il doit garder en mémoire son initialisation même quand on ferme les classeurs

si on fait des replaces
le problème des replaces avec le "#" et le "." me posent problème puisque le replacement dans la requete est l'inverse pour l'un et l'autre
le problème c'est que si le point est vraiment dans le nom il est replacé
bref c'est le serpent qui se mort la queue là
avec des noms simples avec des caractères non speciaux c'est vrai que c'est intéressant

 

[nullosse]

J'exploite le nom des feuilles pour lire le contenu (UsedRange) des feuilles en ADO (de classeurs fermé)

tu es sûr que cela fonctionne si une de tes feuilles à un . ou un ! dans son nom parce que l'ADO doit peut être changer le caractère même en lecture de feuille ?

 

[dysorthographie]

tu es sûr que cela fonctionne si une de tes feuilles à un . ou un ! dans son nom parce que l'ADO doit peut être changer le caractère même en lecture de feuille ?

Bonjour,
Je pense qu'il n'exploite plus 🤣

Function ADONameToExcel(adoName As String) As String
    Dim nom As String
    
    ' Supprimer le $ final si présent
    If Right$(adoName, 1) = "$" Then
        nom = Left$(adoName, Len(adoName) - 1)
    Else
        nom = adoName
    End If
    
    ' Remplacements spécifiques faits par ADO
    nom = Replace(nom, "#", ".") ' le point devient #
    nom = Replace(nom, "_", "!") ' le point d’exclamation devient _
    
    ADONameToExcel = nom
End Function