Autres tester ma pseudo boite de dialogue fichier avec filtre

patricktoulon · 6 Octobre 2024

Bonjour à tous
si il y a des âmes charitables qui voudraient bien tester ma pseudo boite de dialogue fichier avec filtre ca m'arrangerait
en fait je l'ai créée sous trois formae différente

1° la filedilogspecial1
avec un dir en ligne de commande lancée par wscript.shell(.excec) et récupérée par le stdout.readall
ce qui implique une apparition brève mais tout de même de la fenêtre dos

2° la filedilogspecial2
avec un dir en ligne de commande lancée par wscript.shell (.run)et récupérée dans un fichier text temporaire
ce qui implique que la fenêtre dos n'apparait pas puisque je hide la fenêtre

3° la filedilogspecial3
dans celle ci j'utilise un hersats de ma fonction FSOGOSUB de 2021 avec FSO

tout les argument sont optionnels
le choix du fichier se fait au double click
possibilité d'annuler

vous avez 3 module pour tester chaque version
si vous pouviez donc tester la testA4 , TestB4 , TestC4 qui sont selon moi les plus importantes
et me dire si la différence de temps d'apparition de la fenêtre avec la liste de fichier filtrée avec les arguments envoyés par les sub de testsest importante ou pas
voir même cela vous gène t il plus que ça (que la fenêtre dos apparaisse brièvement (pour la fildialoSpecial1) )?

merci aux testeurs

patricktoulon · Vendredi à 11:54

Bonjour @jurassic pork
merci de me le rappeler on l'avait deja remarqué dans les premières versions
c'est vrai que l'on a zappé
je ne sais pas quelle methode utiliser de ma besace utiliser
ma fonction spéciale de lecture ut-8 avec open for ou l'adobd.stream
l'adobd.stream est une librairie que normalement tout les windows ont
mais selon les pcs il est possible que cette librairie soit bloquée
quand a ma fonction de conversion avec open for input elle fonctionne mais ralentirait la chose
à tester

edit: j'ai testé c'est bon

bon au final j'ai opté pour ma petite fonction perso ReadText_UTF8 pour la version 1 avec conversion vbfromunicode et retour en text
et readfile_utf_8 pour la version 2 avec open for en binnary

ces deux fonction sont issue de mon creatorRibbonX For Mac (developper avec ryuautodidacte pour la partie applescript

voila pas de librairie supplémentaire

merci pour le rappel @jurassic pork

je vais attendre les retours de @Staple1600 pour valider cette solution comme finale
Franchement maintenant je ne pourrait pas vous dire la quelle est la plus rapide

jurassic pork · Vendredi à 13:39

readtext_UTF8 ne fonctionne pas chez moi car le codePage de mes fenêtres console c'est pas de l'UTF8 mais du 850 (OEM).
Par contre cette fonction fonctionne :

VB:

Declare PtrSafe Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Function oem2ansi(in_string) As String
Dim Out_String As String * 60000
Dim t As String
t = OemToChar(in_string, Out_String)
oem2ansi = Out_String
End Function

Utilisation :

VB:

Liste = Trim(CreateObject("wscript.shell").exec(TempString).stdout.readall)
    Liste = oem2ansi(Liste)
  '  Liste = ReadText_UTF8(Liste)

J'ai mis 60000 charactères pour la taille de la chaîne Out_String arbitrairement , on ne pourra pas aller guère plus loin. Si il y a plus de charactères dans le résultat de la recherche , cela risque de planter. Il doit y avoir moyen de définir un buffer supérieur.

jurassic pork · Vendredi à 14:20

Bon finalement c'est plus facile que ce que j'ai mis précédemment et il y a pas la limite apparemment (j'ai essayé avec plus de 5000 fichiers)
utiliser directement la procédure oemtochar :

VB:

Liste = Trim(CreateObject("wscript.shell").exec(TempString).stdout.readall)
    OemToChar Liste, Liste

patricktoulon · Vendredi à 14:22

re
et oui mais qui dit buffer supérieur dit plus de mémoire donc ralentissement
au pire on le fait avec les librairie et en plus chez moi ça ne fonctionnera pas puisque je suis en ut-8 pour le readall et utf-8 pour le fichier externe

c'est vraiment un problème ça avec les nouvelle version excel
avant même dans le vbe on était tout en 1552 (ansi)sauf mac
maintenant on sait plus
et je suppose que cela doit être pareil pour le stdout.readall

bon au pire tu a la version 2(si tu n'a pas de problème d'autorisation sur ton disque dur ou dossier

je crois que j'ai bien fait de faire l'exemple 3 avec FSO

patricktoulon · Vendredi à 14:28

Un truc qui me bouffe le mou c'est que
avec des version windows et/ou excel supérieur ,il faille bidouiller pour faire ce que notre bon vieux W2000 faisait en 3 lignes de code
ma conclusion c'est que finalement même si la 1 et 2 sont rapide elles ne sont pas génériques (All Pcs Windows)
c'est affligeant

jurassic pork · Vendredi à 14:32

patricktoulon pour savoir dans quel codepage tu es par défaut dans une invite de commande cmd dis moi ce que renvoie la commande chcp

patricktoulon · Vendredi à 14:39

puré sur w10 c'est 850 et W7 UTF-8
bon alors ca devrait fonctionner chez moi
mais alors je comprends pas pourquoi mes deux fonction utf-8 fonctionnent chez moi j'ai bien mes accents et autres caractères particulier
bizarre ton truc je vais etudier cela

patricktoulon · Vendredi à 14:44

il me semble que la fonction strconv peut recevoir un argument codepage
je vais refaire la fonction readtext....

patricktoulon · Vendredi à 15:14

Bon alors je me suis un peu emmêlé les pinceaux j'ai du faire appel a chatGPT pour me réécrire la fonction
voila plus besoin d'api
donc en gros si on choppe les 3 bit du BOM utf-8 en debut de boucle ou si j'ai un octet > 127 alors on est sur du utf-8 sinon OEM

VB:

Function ReadTextAutoDetect(text As String) As String
    Dim fileContent() As Byte, fileSize&, utf8Index&, charCode&, decodedText$, currentByte As Byte
    Dim tempLong1&, tempLong2&, tempLong3&, tempLong4 As Long
    Dim isUTF8 As Boolean

    ' Convertir le texte en tableau d'octets
    fileContent = StrConv(text, vbFromUnicode)
    fileSize = UBound(fileContent) + 1

    ' Détection de l'encodage par présence du BOM UTF-8
    If fileSize >= 3 And fileContent(0) = &HEF And fileContent(1) = &HBB And fileContent(2) = &HBF Then
        isUTF8 = True
        utf8Index = 3 ' Ignorer le BOM UTF-8
    Else
        ' Estimation de l'encodage si pas de BOM
        isUTF8 = False
        For utf8Index = 0 To fileSize - 1
            If (fileContent(utf8Index) And &H80) Then ' Octet supérieur à 127 trouvé
                isUTF8 = True ' Probablement UTF-8
                Exit For
            End If
        Next
        utf8Index = 0 ' Réinitialiser l'index
    End If

    decodedText = "" ' Initialiser la chaîne de résultat

    ' Décodage en fonction de l'encodage détecté
    Do While utf8Index < fileSize
        currentByte = fileContent(utf8Index)

        If isUTF8 Then
            ' Décodage UTF-8
            Select Case True
                Case (currentByte And &H80) = 0
                    charCode = currentByte
                    utf8Index = utf8Index + 1
                Case (currentByte And &HE0) = &HC0
                    If utf8Index + 1 < fileSize Then
                        tempLong1 = (currentByte And &H1F) * &H40
                        tempLong2 = fileContent(utf8Index + 1) And &H3F
                        charCode = tempLong1 + tempLong2
                        utf8Index = utf8Index + 2
                    Else
                        Exit Do
                    End If
                Case (currentByte And &HF0) = &HE0
                    If utf8Index + 2 < fileSize Then
                        tempLong1 = (currentByte And &HF) * &H1000
                        tempLong2 = (fileContent(utf8Index + 1) And &H3F) * &H40
                        tempLong3 = fileContent(utf8Index + 2) And &H3F
                        charCode = tempLong1 + tempLong2 + tempLong3
                        utf8Index = utf8Index + 3
                    Else
                        Exit Do
                    End If
                Case (currentByte And &HF8) = &HF0
                    If utf8Index + 3 < fileSize Then
                        tempLong1 = (currentByte And &H7) * &H40000
                        tempLong2 = (fileContent(utf8Index + 1) And &H3F) * &H1000
                        tempLong3 = (fileContent(utf8Index + 2) And &H3F) * &H40
                        tempLong4 = fileContent(utf8Index + 3) And &H3F
                        charCode = tempLong1 + tempLong2 + tempLong3 + tempLong4
                        utf8Index = utf8Index + 4
                    Else
                        Exit Do
                    End If
                Case Else
                    utf8Index = utf8Index + 1
                    GoTo NextChar
            End Select
        Else
            ' Décodage OEM-850
            charCode = currentByte
            utf8Index = utf8Index + 1
        End If

        decodedText = decodedText & ChrW(charCode) ' Ajouter le caractère décodé
NextChar:
Loop

ReadTextAutoDetect = decodedText ' Retourne le texte décodé
End Function

fonctionne sur W7 et W10 excel 2013 vba7 32 bitouz

jurassic pork · Vendredi à 17:43

Patrick, je viens d'essayer ton dernier classeur avec Excel 2021 64 bits sous Windows 11
Dans les versions 1 et 2 les lettres avec accents ont disparu dans la ListBox
Dans la version 3 il y a une ligne vide au début de la ListBox

patricktoulon · Vendredi à 17:57

re oui en effet
ce n'est donc ni du 850 ni du utf-8
c'est un truc de fous
le nom original est :"abcédefèjkête.txt"
sans passer par un retraitement

apres traitement utf-8 ou 850 OEM je perds les accents

jurassic pork · Vendredi à 18:27

En tout cas chez moi cela fonctionnait avec mon oemtochar et je suis en codepage 850 dans l'invite de commande.
Dans ton classeur sur le formulaire 1, j'ai changé ceci :

VB:

Private Declare PtrSafe Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

VB:

' La variable Liste récupère le texte du stdout
    Liste = Trim(CreateObject("wscript.shell").exec(TempString).stdout.readall)
    OemToChar Liste, Liste
   ' Liste = ReadTextAutoDetect(Liste)

et j'obtiens ceci :

halecs93 · Vendredi à 19:15

Bonjour,

J'ai testé.... et la troisième boite de dialogue (FSO) me renvoie une erreur de variable non définie....

Quoi qu'il en soit, comment ne pas être admiratif

patricktoulon · Vendredi à 19:47

@jurassic pork je te crois que l'api fonctionne mais le but est de ne pas utiliser d'autre librairie que le shell et le cmd

@halecs93 bonjour
il faut la dimer c'est tout

VB:

Private Sub CommandButton1_Click() 'bouton pour choisir le dossier parent
   Dim fldr As Object
   Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Choisir un dossier à lister"
        .AllowMultiSelect = False
        If .Show = -1 Then TxtbFolder = .SelectedItems(1)
    End With

End Sub

patricktoulon · Vendredi à 22:17

re
@jurassic pork
j'ai adapté sur les deux a mon grand désarroi l'api oemtochar
du coup la 1 la fenetre noire reste plus longtemps
et difficile de dire quelle est la plus rapide entre la 2 et la 3
je pense que je verrais cela à l'utilisation

Autres tester ma pseudo boite de dialogue fichier avec filtre

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Pièces jointes

jurassic pork

XLDnaute Occasionnel

jurassic pork

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

jurassic pork

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

jurassic pork

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

jurassic pork

XLDnaute Occasionnel

halecs93

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes