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:     [ Jetzt bewerten ]	Views:  9.186
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	kein Beispielprojekt

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 12 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.3 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

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