Folge dem Video um zu sehen, wie unsere Website als Web-App auf dem Startbildschirm installiert werden kann.
Anmerkung: Diese Funktion ist in einigen Browsern möglicherweise nicht verfügbar.
Private Sub cmdTest_Click()
Dim c As Control
Dim path() As String
Set c = Me.txtTest
Call pushArray(path, c.Name)
On Error GoTo exit_loop
Do While IsObject(c.Parent)
Call pushArray(path, c.Parent.Name)
Set c = c.Parent
Loop
exit_loop:
Debug.Print Join(path, "!")
End Sub
' /**
' * pushArray
' * add Value to the Array
' * @param Array
' * @param Value
' * @return Ubound of the Array
' */
Public Function pushArray(ByRef ioArray As Variant, ByVal iValue As Variant) As Long
Call ReDimArray(ioArray:=ioArray, oUbound:=pushArray)
ioArray(pushArray) = iValue
End Function
' /**
' * ReDimArray
' * @param in/out Array
' * @param in Step = 1 Anzahl neuer einträge
' * @param out Ubound letzter Index
' * @example ReDimArray(myArray, 3, lastIndex)
' */
Public Function ReDimArray( _
ByRef ioArray As Variant, _
Optional ByVal iStep As Long = 1, _
Optional ByRef oUbound As Long) _
As Variant
If IsEmptyArray(ioArray) Then
ReDim ioArray(iStep - 1)
ElseIf UBound(ioArray) + iStep > -1 Then
ReDim Preserve ioArray(UBound(ioArray) + iStep)
End If
ReDimArray = ioArray
oUbound = UBound(ioArray)
End Function
' /**
' * IsEmptyArray
' * @param Array
' * @return true if Array is not initialized
' */
Public Function IsEmptyArray(ByVal iArray As Variant) As Boolean
Dim Dummy As Long
If IsArray(iArray) Then
'Ggf. Fehler provozieren:
On Error Resume Next
Dummy = LBound(iArray)
'Ergebnis bestimmen:
IsEmptyArray = (Err.Number <> 0)
On Error GoTo 0
Else
Err.Raise 13 'Type mismatch'
End If
End Function
Hast du mein Beispiel gelsen und gestestet?
Mach eine Funktion draus und du hast was du suchst