XL 2013 prise de tête avec une variable static

[patricktoulon]

bonjour a tous
j'ai ressorti une vielle fonction pour un membre du forum et j'ai eu envie de la reduire en terme de code en le réécrivant en mode récursif
alors j'ai un soucis avec une variable static qui joue pas son rôle
en effet cette variable static est dimensionnée a chaque appel
mais à la sortie je n'ai qu'un item
j'ai bien mis un debug.print pour savoir si la donnée du tour récursif etait bon et c'est la cas
quelqu'un aurait pitié de mes cheveux
merci

'******************************************************************************************************************************************************
'    ___      _     _______  __      _    ____  _   _  _______  ___      _   _    _    ___      _     _.
'   //  \\   /\\      //    // \\   //   //    //  //    //    //  \\   //  //   //   //  \\   //|   //
'  //___//  //__\    //    //__//  //   //    //__||    //    //   //  //  //   //   //   //  // |  //
' //       //   \\  //    //  \\  //   //    //  \\    //    //   //  //  //   //   //   //  //  | //
'//       //    // //    //   // //   //___ //    \\  //     \\__//  //__//   //___ \\__//  //   |//
'******************************************************************************************************************************************************
'fonction pour lister les imprimantes pour excel
'patricktoulon sur vdeloppez.com
'date 16/12/2017
'mise à jour :10/12/2023
'api en 64
'mise a jour 10/12/2023
'on passe en mode récursifpour l'enumération

Option Explicit
'32bit'Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal HKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long
'32bits'Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal HKey As Long, ByVal dwIndex As Long, ByVal lpPrinterName As String, lpcbPrinterName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, lpType As Long, lpData As Byte, lpcbData As Long) As Long
'32bits'Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = &H103
Private Const ERROR_MORE_DATA = &HEA
Sub testV2()
    Dim t, i&
    t = GetPrintersListV2
    MsgBox Join(t, vbCrLf)
End Sub

Public Function GetPrintersListV2(Optional IndexKey As Long = 0) As Variant
    Dim hKey As LongPtr, Res&, PrinterName$, LenName&, DataType&, ValueValue() As Byte, i&, t$, a&, b&
    Static printers$(): Static indx As Long
    If IndexKey = 0 Then ReDim printers(1 To 1): indx = 0
    PrinterName = String$(256, " "): LenName = 255: ReDim ValueValue(0 To 200):
    Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, KEY_QUERY_VALUE, hKey)
    RegEnumValue hKey, IndexKey, PrinterName, LenName, 0&, DataType, ValueValue(0), 1000: RegCloseKey hKey
    PrinterName = Trim(PrinterName)
    If Trim(PrinterName) <> "" Then
        a = InStr(1, ValueValue, ","): b = InStr(1, ValueValue, ":")
        t = "": For i = a To b: t = t & Chr(ValueValue(i)): Next: If Trim(t) = "" Then t = " Null"
        
        indx = indx + 1: ReDim Preserve printers(1 To indx): printers(indx) = PrinterName & " sur " & t

        Debug.Print "index de tour récursif = " & indx & ":  index de clé = " & IndexKey & "  --> "; PrinterName & " sur " & t
        GetPrintersListV2 IndexKey + 1
    Else
        Exit Function
    End If
    If IndexKey = 20 Then Exit Function    ' au pire des cas on sort  au bout de 20 essais
    GetPrintersListV2 = printers:
End Function

 

[fanch55]

Salut @patricktoulon ,
Non,non tu n'as pas qu'un item, ton code fonctionne correctement (à un iota près) .
Sauf qu'un paramètre passé à une fonction ( telle que msgbox ) s'arrête au premier char(0) ou vbnullchar.

J'ai donc modifié la fonction ainsi :

        indx = indx + 1: ReDim Preserve printers(1 To indx): printers(indx) = Replace(PrinterName, vbNullChar, "") & " sur " & Replace(t, vbNullChar, "")

 

[job75]

Bonsoir Patrick,

Désolé mais j'ai encore des cheveux et je tiens à les garder

A+

 

[patricktoulon]

re
hoh!! purée j'y ai pas pensé au vbnullchar qui pouvait se trouver devant chaque chaine
j'ai tellement surchauffé cet aprem que je voyais plus rien
merci @fanch55
de temps en temps comme ça quand il y a une demande je ressort mes vieux trucs et les rajeunis un peu

bon ben voila j'ai ma version 2023
pour le coup je repasse en examen chr(0) et je revois la coup à -1 poupe printername et "(t)

'******************************************************************************************************************************************************
'    ___      _     _______  __      _    ____  _   _  _______  ___      _   _    _    ___      _     _.
'   //  \\   /\\      //    // \\   //   //    //  //    //    //  \\   //  //   //   //  \\   //|   //
'  //___//  //__\    //    //__//  //   //    //__||    //    //   //  //  //   //   //   //  // |  //
' //       //   \\  //    //  \\  //   //    //  \\    //    //   //  //  //   //   //   //  //  | //
'//       //    // //    //   // //   //___ //    \\  //     \\__//  //__//   //___ \\__//  //   |//
'******************************************************************************************************************************************************
'fonction pour lister les imprimantes pour excel
'patricktoulon sur vdeloppez.com
'date 16/12/2017
'mise à jour :10/12/2023
'api en 64
'mise a jour 10/12/2023
'on passe en mode récursifpour l'enumération

Option Explicit
'32bit'Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal HKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long
'32bits'Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal HKey As Long, ByVal dwIndex As Long, ByVal lpPrinterName As String, lpcbPrinterName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, lpType As Long, lpData As Byte, lpcbData As Long) As Long
'32bits'Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = &H103
Private Const ERROR_MORE_DATA = &HEA
Sub testV2()
    Dim t, i&
    t = GetPrintersListV2
    MsgBox Join(t, vbCrLf)
End Sub

Public Function GetPrintersListV2(Optional IndexKey As Long = 0) As Variant
    Dim hKey As LongPtr, Res&, PrinterName$, DataType&, ValueValue() As Byte, i&, tx$, t$, a&, b&
    Static printers$(): Static indx As Long
    PrinterName = String$(256, Chr(0)): ReDim ValueValue(0 To 999): If IndexKey = 0 Then ReDim printers(1 To 1): indx = 0
    RegOpenKeyEx HKCU, PRINTER_KEY, 0&, KEY_QUERY_VALUE, hKey
    RegEnumValue hKey, IndexKey, PrinterName, Len(PrinterName), 0&, DataType, ValueValue(0), 1000: RegCloseKey hKey
    PrinterName = Split(PrinterName, Chr(0))(0)
    If Trim(PrinterName) <> "" Then
        t = StrConv(ValueValue, vbUnicode): a = InStr(1, t, ","): b = InStr(1, t, ":")
        tx = "": For i = a + 1 To b - 1: tx = tx & Mid(t, i, 1): Next:
        indx = indx + 1: ReDim Preserve printers(1 To indx): printers(indx) = PrinterName & " sur " & tx
        GetPrintersListV2 IndexKey + 1
    End If
    If IndexKey = 20 Then Exit Function    ' au pire des cas on sort  au bout de 20 essais
    GetPrintersListV2 = printers:
End Function

j'en reviens pas que j'ai manqué ça