vb@rchiv · Tipps & Tricks · Analyse eines beliebigen Variablentyps

Rubrik: Variablen/Strings · Sonstiges | VB-Versionen: VB5, VB6

18.03.08

Analyse eines beliebigen Variablentyps Mit der hier vorgestellten Funktion wird eine beliebige Variable (Übergabe) auf DatenTyp, Dimensionszahl u. FeldArrayIndex geprüft.
Autor: Norbert Grimm	Bewertung:	Views: 9.202
ohne Homepage	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	kein Beispielprojekt

Mit der hier vorgestellten Funktion CheckArrayDim wird eine beliebige Variable (Übergabe) auf DatenTyp, Dimensionszahl u. FeldArrayIndex geprüft.

Dies ist ein einfache Beispielfunktion, die auf keine API-Funktion zurückgreift.

' Diese Funktion analysiert die in [vWert] übergebene Variable.
'
' vWert         : beliebiger VariablenTyp
'
' Rückgabe
' iTyp          : VariablenTyp
' iDim          : Anzahl der Dimensionen
' iIndex()      : IntegerArray->ReDim in Funktion
'
'                 ArrayFeldIndices
' iIndex(x, 0)  : unterer Index, x.Dimension
' iIndex(x, 1)  : oberer  Index, x.Dimension
'
Function CheckArrayDim(ByVal vWert As Variant, _
  iTyp As Integer, _
  iDim As Integer, _
  iIndex() As Integer) As Long
 
  Dim D       As Integer
  Dim I       As Integer
  Dim U       As Integer
  Dim nErr    As Long
  Dim Ret     As Long
 
  ' iTyp   :
  ' 0      : Empty     ' Variant
  ' 1
  ' 2      : Integer
  ' 3      : Long
  ' 4      : Single
  ' 5      : Double
  ' 8      : String
  ' 11     : Boolean
  ' 12     : Variant
  ' <Array>: +8192     ' vbArray
  ' 8194   : Integer
  ' 8195   : Long      ' 8195 = 3 + 8192
  ' 8196   : Single
  ' 8197   : Double
  ' 8200   : String
  ' 8203   : Boolean
  ' 8204   : Variant
 
  iTyp = VarType(vWert)
  If iTyp >= vbArray Then ' ist Array
    On Error Resume Next
    ' Dimensionen bestimmen
    Do
      D = D + 1
      U = UBound(vWert, D)
      With Err
        If .Number <> 0 Then        ' Err: 9
          nErr = .Number
          .Number = 0
          D = D - 1                 ' sub 1, weil Err
        End If
      End With
    Loop While nErr = 0
    iDim = D
    On Error GoTo Err_CAD
  Else                              ' kein Array
  End If
 
  ' ArrayFeldIndices
  ReDim iIndex(iDim, 1)
  D = 0
  For I = 1 To iDim
    D = D + 1
    iIndex(I, 0) = LBound(vWert, D)     ' unterer Index
    iIndex(I, 1) = UBound(vWert, D)     ' oberer  Index
  Next I
 
  ' Ret =  0 , o.k.
  '     <> 0 , Fehler
 
Exit_CAD:
  CheckArrayDim = Ret
  Exit Function
 
Err_CAD:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_CAD
End Function

Testaufruf für CheckArrayDim

Function CheckVariable() As Long
  Dim A               As Long
  Dim AA(10)          As Long
  Dim AAA(10, 5)      As Long
  Dim AAAA(10, 5, 2)  As Long
  Dim I               As Integer
  Dim vMsg            As Variant
 
  Dim iTyp            As Integer
  Dim iDim            As Integer
  Dim iIndex()        As Integer
 
  Dim Ret             As Long
 
  ' z.B.:
  Ret = CheckArrayDim(AAA, iTyp, iDim, iIndex)
 
  MsgBox "Ret : " & Ret & vbCr _
    & "Typ : " & iTyp & vbCr _
    & "Dim : " & iDim, vbInformation, "CheckArrayDim" & Space(10)
 
  '         AAA          AA           A
  ' Ret :   0            0            0
  ' Typ :   8195         8195         3
  ' Dim :   2            1            0
 
  vMsg = "unterer -" & Space(2) & "oberer Index:" & vbCr
  For I = 1 To iDim
    vMsg = vMsg & iIndex(I, 0) & Space(15) & iIndex(I, 1) & vbCr
  Next I
 
  MsgBox vMsg, vbInformation, "ArrayFeldIndices"
  ' AAA
  ' unterer - oberer Index:
  ' 0           10
  ' 0           5
End Function