XL 2013 connaitre le type de variable tableau un ou 2 dim et le sens

[patricktoulon]

Bonjour a tous
je cherche un moyen efficace de savoir quelle est le type de variable tableau une ou deux dim et est une ligne ou une colonne sans avoir a gérer des erreurs dans un sens ou dans l'autre
@Yeahou a donné un début de piste interessant mais c'est pas full right

Sub testy7()
a = [A1:H1].Value
MsgBox oneDim(a)
End Sub

Sub testy8()
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
MsgBox oneDim(a)
End Sub

Sub testy9()
Dim a(0 To 5, 1)
  a(5, 0) = "toto "
MsgBox oneDim(a) & " " & UBound(a, 2)
End Sub

'***********************************************************
'ERREUR!!!!
Sub testy10() ' erreur donne vrai quand base 0
Dim a(0 To 5, 0)
  a(5, 0) = "toto "
 'a(5) = "titi"    'erreur " nombre de dimensions incorect"
Msgbox  oneDim(a) & " " & UBound(a, 2)
End Sub
'***********************************************************

Sub testy11() '
Dim a(0 To 5)
MsgBox oneDim(a)
End Sub

Function oneDim(a)
  oneDim = UBound(a) + 1 - LBound(a) = Application.CountA(a)
End Function

il faudrait le moyen de compter le base 0 et ce sera bon

 

[patricktoulon]

j'ai essayé hier
Re Bonjour Dudu2
je sais pas si c'est possible quand les arguments sont des conteneur(type) , array et autres que string ,double ou long
si c'est possible je ne sais pas encore comment faire

 

[ChTi160]

Bonjour le fil ,le Forum
Courage !
jean marie

 

[patricktoulon]

re
pas d'inquiétude si c'est possible je trouverais
quand j'ai des moment libres je teste plein de trucs

 

[ChTi160]

re
je n'en doute pas ! Lol
jean marie

 

[Dudu2]

Je veux bien essayer en parallèle.
Mais il faudrait que tu m'expliques (si tu le sais of course) comment valoriser ce foutu 3ème paramètre ("JJJJ" ...). Je crois qu'on a abordé la question dans un autre sujet mais je ne me souviens plus lequel.

 

[patricktoulon]

a tu veux les "AS"
normalement
declare function nomapi" Lib nomdll" (byval x as long,byaval truc as string,byval machin as long) as long

en fait ce qu'il y a dans les guillemet sont les "as"
exemple

'B - nombre à virgule flottante de 8 octets (IEEE), transféré par valeur, type C double.

'C - Chaîne terminée par zéro (null) (longueur max. = 255 caractères), transférée par référence, type C char *

'F - Chaîne terminée par zéro (null) (longueur max. = 255 caractères), transférée par référence (modifier sur place) , Type C char *

'J - entier signé de 4 octets de large, transféré par valeur, type C long int

'P - structure de données OPER d'Excel, transféré par référence, type C OPER *

je permier c'est le retour du as de la fin
les autres sont les "as" dans la parenthèse
quand c'est un contexte handle on ajoute encore un J devant

exemple concret extrait de mon tuto

'Api SetWindowLongA application de modification sur fenetre
' ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & dwNewLong & ")")

pour le moment je n'ai codé qu'une 50 aine d'api dans mon tuto
quand j'ai le temps j'ajoute
quand j'en aurais une bonne centaine je vous ferais un PDF

 

[Dudu2]

OK merci pour ton retour.
Confirmé par la doc MS dont il serait bien que tu mettes la référence dans ton tuto PDF:

Utilisation des fonctions FONCTION.APPELANTE et REGISTRE - Support Microsoft

Décrit la syntaxe de formule et l’utilisation des fonctions FONCTION.APPELANTE, REGISTRE et REGISTRE.NUMERO dans Excel.

support.microsoft.com

Le premier caractère de l’argument type_texte concerne le type de données de la valeur renvoyée. Les caractères suivants indiquent les types de données de tous les arguments.

Le problème étant effectivement comment passer les adresses d'objets (VarPtr ?) en Long ou LongPtr.
Il faudrait savoir comment Excel fait pour passer les pointeurs.
Ou lire le Guide du développeur Microsoft Office .

 

[patricktoulon]

re
avec les macro4 long ou longptr c'est pareil "J" prend les deux et si c'est pas suffisant c'est "JJ"
c'est plutôt les type conteneur et array que je n'ai jamais trouvé

 

[laurent950]

Bonsoir @Dudu2, et @patricktoulon

Hello @patricktoulon,

Je ne sais pas si tu as pu voir ma demande d'ExecuteExcel4Macro'ifier cette fonction qui contient la fonction API RtlMoveMemory (copie mémoire) ou si tu y a renoncé car pas possible.
En tous cas j'aimerais bien avoir ton retour sur cette option car je n'ai pas réussi à le faire.

Option Explicit

'https://stackoverflow.com/questions/6901991/how-to-return-the-number-of-dimensions-of-a-variant-variable-passed-to-it-in-v

#If VBA7 Then
Private Type Pointer: Value As LongPtr: End Type
Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef src As Any, ByVal Size As LongPtr)
#Else
Private Type Pointer: Value As Long: End Type
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByRef dest As Any, ByRef src As Any, ByVal Size As Long)
#End If

Private Type TtagVARIANT
vt As Integer
r1 As Integer
r2 As Integer
r3 As Integer
sa As Pointer
End Type

Public Function GetDims(source As Variant) As Integer
Dim va As TtagVARIANT

Peut être comme cela :

#If VBA7 Then
  Private Declare PtrSafe Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (ByRef dest As Any, ByVal src As LongPtr, ByVal Size As LongPtr)
#Else
  Private Declare Sub memcpy Lib "kernel32.dll" (ByRef dest As Any, ByRef src As Any, ByVal Size As Long)
#End If

Public Function GetDimensions(source As Variant) As Integer
' Nota
'    VT_ARRAY = &H2000 ' Tableau 1 Dimension
'    VT_BYREF = &H4000  ' Tableau 2 Dimensions et 3D, 4D , et Plus...
Dim vt As Long, ptr As LongPtr
    memcpy vt, VarPtr(source), 2                             ' read the variant type (2 bytes)                     '
        If (vt And &H2000) = 0 Then Exit Function            ' return 0 if not an array                            '
            memcpy ptr, VarPtr(source) + 8, Len(ptr)         ' read the variant data at offset 8                   '
        If (vt And &H4000) Then memcpy ptr, ptr, Len(ptr)    ' read by reference if the data is a reference        '
        If ptr Then memcpy GetDimensions, ptr, 2             ' read the number of dimensions at offset 0 (2 bytes) '
End Function

Sub Test()
    Dim t As Variant
 
    t = Array(1, 2, 3)
    MsgBox GetDimensions(t)
 
    t = [A1:A12].Value
    MsgBox GetDimensions(t)
 
    t = [A1:L1].Value
    MsgBox GetDimensions(t)

    t = [A1:L12].Value
    MsgBox GetDimensions(t)
End Sub

sur cette ligne
memcpy ptr, ptr, Len(ptr)
memcpy ptr, VarPtr(source) + 8, Len(ptr)
memcpy GetDimensions, ptr, 2 ici c'est indiqué (' read the number of dimensions at offset 0 (2 bytes) ) !

en rapport avec cette fonction :
Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef src As Any, ByVal Size As LongPtr)

Comment les Dimensions de la variables tableau sont récupérer ?
Le Code ptr (n'est pas fixe mais variable c'est pas un ID (le numéro change a chaque fois)

Est il possible de modifier le code pour attraper cette variable :
- ByVal Size As Long
Qui doit correspondre au nombre de dimension(s) en rapport avec la variable Ptr ?

Laurent

 

[Dudu2]

Bonjour @laurent950
Ton code retourne systématiquement 28564 chez moi.
Pour info le problème posé en 2ème étape est de se passer de la déclaration de la fonction API et de l'appeler via ExecuteExcel4Macro. @patricktoulon est le spécialiste de cette manip mais pour le moment il y a un blocage sur la transmission d'arguments qui ne sont pas des valeurs simples.

 

[laurent950]

Re @Dudu2
https://docs.microsoft.com/fr-fr/office/vba/language/concepts/getting-started/declaring-arrays

j'ai trouvé une explication avec les Bytes
read the number of dimensions at offset 0 (2 bytes)

Le code du Poste #99 à était trouvé ici :
https://webdevdesigner.com/q/how-to...a-variant-variable-passed-to-it-in-vba-20645/

 

[Dudu2]

Ça c'est la méthode simple avec un On Error.

D'ailleurs je ne sais pas pourquoi @patricktoulon veut une méthode qui n'utilise pas On Error. Peut-être pour ne pas activer le mécanisme d'interruption des erreurs pour des questions de coût CPU ? Ou peut-être parce que On Error n'est pas une solution intellectuellement satisfaisante. Toujours est-il que c'est sa demande.

La solution du Post #85 fonctionne. Mais depuis que l'ami @patricktoulon a décidé de ne plus déclarer les fonctions API et d'utiliser ExecuteExcel4Macro pour les appeler, cette solution faisant appel direct à l'API RtlMoveMemory est vue comme trop "lourde". Il faut donc la rendre présentable et la faire tourner avec ExecuteExcel4Macro ce qui n'est pas aussi simple.

 

[patricktoulon]

perso a utiliser une petite boucle j'ai une petite idée (pas bien claire encore ) se passer d'une gestion d'erreur

supposons que nous injectons dans la fonction un array une colonne ou une ligne
dans la fonction
on redim une autre variable tableau (ubound( la variable injectée),2)
je boucle for each et incrémente une variable long
a la fin la variable long est le nombre de case de la variable et je lui enlève le ubound()
je devrait me retrouver avec le nombre d'item juste si c'est un array ou si c'est une ligne non ?
reste a adapter cela pour une colonne

oui Dudu2 c'est bien ça perso je ne trouve pas les gestion d'erreur intellectuellement satisfaisantes
et c'est vrai que pour de grand travaux sur tableaux et array de grande taille la différence est flagrante

je sais pas ce que vous en pensez mais voilà
on a bien un résultat différent selon le tupe de tableaux

Sub test1()
t = [A1:A10].Value
ReDim tx(LBound(t) To UBound(t), 1)
i = LBound(t) - 1
For Each element In tx: i = i + 1: Next
MsgBox i / 2
End Sub
Sub test2()
t = [A1:j1].Value
ReDim tx(LBound(t) To UBound(t), 1)
i = LBound(t) - 1
For Each element In tx: i = i + 1: Next
MsgBox i / 2

End Sub
Sub test()
t = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
ReDim tx(LBound(t) To UBound(t), 1)
i = LBound(t) - 1
For Each element In tx: i = i + 1: Next
MsgBox i / 2

End Sub

 

[Dudu2]

Y a un truc que je pige pas.
Est-ce que l'hypothèse initiale est qu'on a toujours un Array à 2 dimensions ?
Ou bien on ne connait pas le nombre de dimensions du tableau ?

Parce que dans le 2ème cas, sans On Error ou API on ne peut pas différencier (avec un CountA) un tableau à 1 dimension et un tableau à 2 dimensions dont la 2ème (ou la 1ère) est 1. Et encore je me demande ce que peut coûter un CountA sur un grand tableau (peut-être rien ...?).

 

[patricktoulon]

non Dudu2 hypothèse initiale c'est les 3 possibilités ligne , colonne , array

un petit essaie en suivant ma logique
A tester sous toute les coutures car ( je fait ça vite fait)
je suis pas tres satisfait de mon dernier switch "array" mais bon

normalement

1. si c'est un 2 dim (1 ligne ,x colonnes) ça doit toujours ramener "1"
2. si c'est une colonne ça doit toujours ramener le ubound()
3. autrement ben c'est un array

Sub test1()
t = [A1:A10].Value
MsgBox GetTypeArray(t)
End Sub

Sub test2()
t = [A1:z1].Value
MsgBox GetTypeArray(t)
End Sub

Sub test()
t = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
MsgBox GetTypeArray(t)
End Sub

Function GetTypeArray(t)
ReDim tx(LBound(t) To UBound(t), 1)
i = LBound(t) - 1
For Each element In tx: i = i + 1: Next
x = i / 2
GetTypeArray = Switch(x = 1, "ligne", x = UBound(t), "Colonne", x < UBound(t) Or x > 1, "array")
End Function