Hallo Uwe,

richtig, die gezeigte Funktion erzeugt nur die gewünschten Controls. Aber mit dieser Funktion ist das Erzeugen ziemlich praktisch, weil man damit in einer verschachtelten Schleife sehr einfach ein Grid erzeugen kann, wo man genau die Größe und Position der Controls (In diesem Fall, geht es mir um Textboxen) festlegen kann.

Bei den Werten geht es nur darum, sie in einer Minidatenbank zu speichern, und beim Start wieder einzulesen. Der Code dazu:

in einem Standardmodul (basClasses):

Option Explicit

Option Private Module



Public NoEvent As Boolean



Public ProductType As clsProductType

Public SingleProduct As clsSingleProduct

Public gGridForm As frmGridEditor

'Public gCtlWatchers As Collection ' hält Instanzen von clsControlEvents / clsWatchEvents

Public idCount As Long

Private mCols As Long, mRows As Long



Private Type ProdType

    prodTypeID As String * 20

    SingProdID As String * 20

    ProdTypeName As String * 25

    SingProdName As String * 25

    SingProdBackCol As String * 8

    SingProdForeCol As String * 8

End Type



Public Sub ShowProductGrid()

    ' ProductType muss gefüllt sein (z. B. durch testProductsClasses)

    If Not classIsInitialized(ProductType) Then Set ProductType = New clsProductType



    'mRows = IIf(ProductType Is Nothing, 0, ProductType.Count)

    'mCols = singleProductTotalCount()



    Set gGridForm = New frmGridEditor

    Set gCtlWatchers = New Collection



    gGridForm.Show vbModeless

    

    'BuildGrid mRows, mCols

    

    

End Sub

Public Sub testProductClasses()

    'Mit diesem Sub lassen sich die sich die Klassen zu Testzwecken mit Beispieldaten füllen

    Dim rows As Long, cols As Long, X As Long, Y As Long, aCounter As Long, bCounter As Long

    

    rows = 5

    cols = 4

    

    'bCounter = 1

    

    Set ProductType = New clsProductType

    

    For X = 1 To rows

    

        Call ProductType.Add("X" & Left("00000" & CStr(X), 6), "Name" & CStr(X))



        Set SingleProduct = New clsSingleProduct

        

        For Y = 1 To cols

                           

            Call ProductType(X).SingleProduct.Add(createID, "Produkt" & CStr(Y), 65535, 0)

        

        Next Y

        

    Next X



End Sub







Public Function createID() As String

    Dim Y As Long

    'If idCount = 10 Then Stop

    idCount = idCount + 1

    createID = "X" & Right("00000" & CStr(idCount), 6)

End Function



Public Sub writeProducts() 'Speichert die Klasse ProductType.SingleProduct in einer Minidatenbank

    Dim X As Long, Y As Long

    Dim Intfile As Integer

    Dim TypeConvert As ProdType

    Dim myPath As String

    

    Call testProductClasses

    

    Const myFilename As String = "CartData.mealcards"

    

    myPath = MainPath & "DATA\" & myFilename

    

    Dim pvstrFiller As String

    

    For X = 1 To 25

        pvstrFiller = pvstrFiller & Chr(12)

    Next X

    

    If IsFileOpen(myPath) = 0 Then Kill myPath

    Intfile = FreeFile

    

    Open myPath For Random As #Intfile Len = Len(TypeConvert)



        For X = 1 To ProductType.Count

            For Y = 1 To ProductType(X).SingleProduct.Count

                With TypeConvert

                    .prodTypeID = Right(pvstrFiller & CStr(ProductType(X).ID), 20)

                    .ProdTypeName = Right(pvstrFiller & CStr(ProductType(X).Name), 25)

                    .SingProdID = Right(pvstrFiller & CStr(ProductType(X).SingleProduct(Y).ID), 20)

                    .SingProdName = Right(pvstrFiller & CStr(ProductType(X).SingleProduct(Y).Name), 25)

                    .SingProdBackCol = Right(pvstrFiller & CStr(ProductType(X).SingleProduct(Y).BackColor), 8)

                    .SingProdForeCol = Right(pvstrFiller & CStr(ProductType(X).SingleProduct(Y).ForeColor), 8)

                End With

                Put #Intfile, , TypeConvert

            Next Y

        Next X

        

    Close #Intfile

    

End Sub







Public Sub readProductsALT()

    Dim X As Long, Intfile As Integer, myPath As String, TypeConvert As ProdType

    Const myFilename As String = "CartData.mealcards"

    

    On Error Resume Next



    myPath = MainPath & "DATA\" & myFilename

        

    If Not classIsInitialized(ProductType) Then

        Set ProductType = New clsProductType

    Else

        Set ProductType = Nothing

        Set ProductType = New clsProductType

    End If



    Intfile = FreeFile

    If Dir(myPath) = "" Then Exit Sub



    Open myPath For Random As #Intfile Len = Len(TypeConvert)



    Do While Not EOF(Intfile)

        X = X + 1

        Get #Intfile, , TypeConvert

        With TypeConvert

            Call ProductType.Add(removeChr12(.prodTypeID), removeChr12(.ProdTypeName))

            Do

                

                

                

            

            Loop

        End With

    Loop

End Sub





Public Sub readProducts()

    Dim TypeConvert As ProdType

    Dim Intfile As Integer

    Dim myPath As String

    Const myFilename As String = "CartData.mealcards"

    Dim existing As clsProductType



    myPath = MainPath & "DATA\" & myFilename



    If Not classIsInitialized(ProductType) Then

        Set ProductType = New clsProductType

    Else

        Set ProductType = Nothing

        Set ProductType = New clsProductType

    End If



    Intfile = FreeFile

    If Dir(myPath) = "" Then Exit Sub



    Open myPath For Random As #Intfile Len = Len(TypeConvert)



    On Error GoTo Cleanup



    Do While Not EOF(Intfile)

        Get #Intfile, , TypeConvert



        ' ProdTypeID bereinigen (falls Chr(12) am Anfang vorhanden)

        Dim prodTypeID As String

        prodTypeID = CStr(removeChr12(TypeConvert.prodTypeID))



        ' Prüfen, ob ProdType bereits existiert

        On Error Resume Next

        Set existing = ProductType.Item(prodTypeID)

        If Err.Number <> 0 Then

            Err.Clear

            'Neu anlegen (Name bereinigen)

            Call ProductType.Add(prodTypeID, CStr(removeChr12(TypeConvert.ProdTypeName)))

            Set existing = ProductType.Item(removeChr12(prodTypeID))

        Else

            'ggf. Name ergänzen, falls leer

            If existing.Name = "" Then existing.Name = CStr(removeChr12(TypeConvert.ProdTypeName))

        End If

        On Error GoTo Cleanup



        'SingleProduct zur gefundenen/erstellten ProductType-Instanz hinzufügen

        With TypeConvert

            existing.SingleProduct.Add _

                CStr(removeChr12(.SingProdID)), _

                CStr(removeChr12(.SingProdName)), _

                CLng(removeChr12(.SingProdBackCol)), _

                CLng(removeChr12(.SingProdForeCol))

        End With



        Set existing = Nothing

    Loop



Cleanup:

    If Err.Number <> 0 Then

         'Fehlerbehandlung: optional Debug-Ausgabe

         Debug.Print "readProducts Fehler: " & Err.Number & " - " & Err.Description

        Err.Clear

    End If



    If Intfile <> 0 Then Close #Intfile

End Sub

Public Function removeChr12(pvString As String) As String

    If Len(pvString) = 0 Then

        removeChr12 = pvString

        Exit Function

    End If



    Do While Len(pvString) > 0 And Left$(pvString, 1) = Chr$(12)

        pvString = Mid$(pvString, 2)

    Loop



    removeChr12 = pvString

End Function



Public Function IsFileOpen(filename As String) As Integer

    Dim filenum As Integer, errnum As Integer

    On Error Resume Next

    filenum = FreeFile()

    Open filename For Input Lock Read As #filenum

    Close filenum

    errnum = Err

    On Error GoTo 0

    IsFileOpen = errnum

End Function



Public Function singleProductTotalCount() As Long

    Dim X As Long, Y As Long

    

    singleProductTotalCount = 0

    

    For X = 1 To ProductType.Count

        If singleProductTotalCount < ProductType(X).SingleProduct.Count Then

            singleProductTotalCount = ProductType(X).SingleProduct.Count

        End If

    Next X

    

    singleProductTotalCount = singleProductTotalCount + 1

End Function







Public Function classIsInitialized(pvobjClass As Object) As Boolean

    Dim ID_Check As String

    On Error GoTo errorhandler

    

    ID_Check = ProductType(1).ID

    

    classIsInitialized = True

    

Exit Function



errorhandler:

    classIsInitialized = False

    

End Function

In einem Klassenmodul (clsProductType):

Option Explicit

Option Compare Text



'Modulname: clsProductType



Private mstrID As String

Private mstrName As String

Private mobjSingleProduct As clsSingleProduct

Private mobjProductType As Collection



Private Sub Class_Initialize()

    Set ProductType = New Collection

    Set SingleProduct = New clsSingleProduct

End Sub



Private Sub Class_Terminate()

    Set ProductType = Nothing

    Set SingleProduct = Nothing

End Sub



Friend Property Get ID() As String

    ID = mstrID

End Property

Friend Property Let ID(ByVal pvstrID As String)

    mstrID = pvstrID

End Property



Friend Property Get Name() As String

    Name = mstrName

End Property

Friend Property Let Name(ByVal pvstrName As String)

    mstrName = pvstrName

End Property



Friend Property Get ProductType() As Collection

    Set ProductType = mobjProductType

End Property

Friend Property Set ProductType(ByRef pvobjProductType As Collection)

    Set mobjProductType = pvobjProductType

End Property



Friend Property Get SingleProduct() As clsSingleProduct

    Set SingleProduct = mobjSingleProduct

End Property

Friend Property Set SingleProduct(ByRef pvobjSingleProduct As clsSingleProduct)

    Set mobjSingleProduct = pvobjSingleProduct

End Property



Friend Sub Add( _

    ByVal pvstrID As String, ByVal pvstrName As String)



    Dim objProductTypeClass As clsProductType



    Set objProductTypeClass = New clsProductType



    With objProductTypeClass

        .ID = pvstrID

        .Name = pvstrName

        Set .SingleProduct = New clsSingleProduct

    End With



    Call ProductType.Add(Item:=objProductTypeClass, key:=pvstrID)



    Set objProductTypeClass = Nothing



End Sub



Friend Sub Move( _

    ByVal pvvntIndex As Variant, _

    Optional ByVal opvvntBefore As Variant = Empty, _

    Optional ByVal opvvntAfter As Variant = Empty)

    Dim objProductType As clsProductType

    If Not IsEmpty(opvvntBefore) Then

        With Me

            Set objProductType = .Item(pvvntIndex)

            Call .Delete(pvvntIndex)

            Call ProductType.Add(Item:=objProductType, key:=pvvntIndex, Before:=opvvntBefore)

        End With

        Set objProductType = Nothing

    ElseIf Not IsEmpty(opvvntAfter) Then

        With Me

            Set objProductType = .Item(pvvntIndex)

            Call .Delete(pvvntIndex)

            Call ProductType.Add(Item:=objProductType, key:=pvvntIndex, Before:=opvvntAfter)

        End With

        Set objProductType = Nothing

    Else

        Call MsgBox("Fehlender Parameter in der Move-Methode der " & _

            "ProductType-Klasse.", vbCritical, "Methode fehlgeschlagen")

    End If

End Sub



Private Function SortString(ByVal pvlngIndex As Long) As String

    SortString = Item(pvlngIndex).Name

End Function



Friend Sub Sort( _

    Optional ByVal opvenmSortOrder As XlSortOrder = xlAscending, _

    Optional ByVal opvvntLBound As Variant, _

    Optional ByVal opvvntUBound As Variant)

    Dim lngIndex1 As Long, lngIndex2 As Long

    Dim vntBuffer As Variant

    If IsMissing(opvvntLBound) Then opvvntLBound = 1

    If IsMissing(opvvntUBound) Then opvvntUBound = Count

    lngIndex1 = opvvntLBound

    lngIndex2 = opvvntUBound

    vntBuffer = SortString((lngIndex1 + lngIndex2) \ 2)

    Do

        If opvenmSortOrder = xlAscending Then

            Do While SortString(lngIndex1) < vntBuffer

                lngIndex1 = lngIndex1 + 1

            Loop

            Do While vntBuffer < SortString(lngIndex2)

                lngIndex2 = lngIndex2 - 1

            Loop

        Else

            Do While SortString(lngIndex1) > vntBuffer

                lngIndex1 = lngIndex1 + 1

            Loop

            Do While vntBuffer > SortString(lngIndex2)

                lngIndex2 = lngIndex2 - 1

            Loop

        End If

        If lngIndex1 < lngIndex2 Then

            Call Move(pvvntIndex:=Item(lngIndex1).ID, _

                opvvntBefore:=Item(lngIndex2).ID)

            Call Move(pvvntIndex:=Item(lngIndex2).ID, _

                opvvntBefore:=Item(lngIndex1).ID)

            lngIndex1 = lngIndex1 + 1

            lngIndex2 = lngIndex2 - 1

        ElseIf lngIndex1 = lngIndex2 Then

            lngIndex1 = lngIndex1 + 1

            lngIndex2 = lngIndex2 - 1

        End If

    Loop Until lngIndex1 > lngIndex2

    If opvvntLBound < lngIndex2 Then Call Sort( _

        opvenmSortOrder, opvvntLBound, lngIndex2)

    If lngIndex1 < opvvntUBound Then Call Sort( _

        opvenmSortOrder, lngIndex1, opvvntUBound)

End Sub



Friend Function Count() As Long

    Count = ProductType.Count

End Function



Friend Sub Delete(ByVal pvvntIndex As Variant)

    Call ProductType.Remove(pvvntIndex)

End Sub



Public Function Item(ByVal pvvntIndex As Variant) As clsProductType

    Set Item = ProductType.Item(pvvntIndex)

End Function



Public Function NewEnum() As IUnknown

    Set NewEnum = ProductType.[_NewEnum]

End Function

Und in einem weitereren Klassenmodul die untergeordnete Klasse (clsSingleProduct):

Option Explicit

Option Compare Text



'Modulname: clsSingleProduct



Private mstrID As String

Private mstrName As String

Private mlngBackColor As Long

Private mlngForeColor As Long

Private mobjSingleProduct As Collection



Private Sub Class_Initialize()

    Set SingleProduct = New Collection

End Sub



Private Sub Class_Terminate()

    Set SingleProduct = Nothing

End Sub



Friend Property Get ID() As String

    ID = mstrID

End Property

Friend Property Let ID(ByVal pvstrID As String)

    mstrID = pvstrID

End Property



Friend Property Get Name() As String

    Name = mstrName

End Property

Friend Property Let Name(ByVal pvstrName As String)

    mstrName = pvstrName

End Property



Friend Property Get BackColor() As Long

    BackColor = mlngBackColor

End Property

Friend Property Let BackColor(ByVal pvlngBackColor As Long)

    mlngBackColor = pvlngBackColor

End Property



Friend Property Get ForeColor() As Long

    ForeColor = mlngForeColor

End Property

Friend Property Let ForeColor(ByVal pvlngForeColor As Long)

    mlngForeColor = pvlngForeColor

End Property



Friend Property Get SingleProduct() As Collection

    Set SingleProduct = mobjSingleProduct

End Property

Friend Property Set SingleProduct(ByRef pvobjSingleProduct As Collection)

    Set mobjSingleProduct = pvobjSingleProduct

End Property



Friend Sub Add( _

    ByVal pvstrID As String, ByVal pvstrName As String, ByVal pvlngBackColor As Long, ByVal pvlngForeColor As Long)



    Dim objSingleProductClass As clsSingleProduct



    Set objSingleProductClass = New clsSingleProduct



    With objSingleProductClass

        .ID = pvstrID

        .Name = pvstrName

        .BackColor = pvlngBackColor

        .ForeColor = pvlngForeColor

    End With



    Call SingleProduct.Add(Item:=objSingleProductClass, key:=pvstrID)



    Set objSingleProductClass = Nothing



End Sub



Friend Sub Move( _

    ByVal pvvntIndex As Variant, _

    Optional ByVal opvvntBefore As Variant = Empty, _

    Optional ByVal opvvntAfter As Variant = Empty)

    Dim objSingleProduct As clsSingleProduct

    If Not IsEmpty(opvvntBefore) Then

        With Me

            Set objSingleProduct = .Item(pvvntIndex)

            Call .Delete(pvvntIndex)

            Call SingleProduct.Add(Item:=objSingleProduct, key:=pvvntIndex, Before:=opvvntBefore)

        End With

        Set objSingleProduct = Nothing

    ElseIf Not IsEmpty(opvvntAfter) Then

        With Me

            Set objSingleProduct = .Item(pvvntIndex)

            Call .Delete(pvvntIndex)

            Call SingleProduct.Add(Item:=objSingleProduct, key:=pvvntIndex, Before:=opvvntAfter)

        End With

        Set objSingleProduct = Nothing

    Else

        Call MsgBox("Fehlender Parameter in der Move-Methode der " & _

            "SingleProduct-Klasse.", vbCritical, "Methode fehlgeschlagen")

    End If

End Sub



Private Function SortString(ByVal pvlngIndex As Long) As String

    SortString = Item(pvlngIndex).Name

End Function



Friend Sub Sort( _

    Optional ByVal opvenmSortOrder As XlSortOrder = xlAscending, _

    Optional ByVal opvvntLBound As Variant, _

    Optional ByVal opvvntUBound As Variant)

    Dim lngIndex1 As Long, lngIndex2 As Long

    Dim vntBuffer As Variant

    If IsMissing(opvvntLBound) Then opvvntLBound = 1

    If IsMissing(opvvntUBound) Then opvvntUBound = Count

    lngIndex1 = opvvntLBound

    lngIndex2 = opvvntUBound

    vntBuffer = SortString((lngIndex1 + lngIndex2) \ 2)

    Do

        If opvenmSortOrder = xlAscending Then

            Do While SortString(lngIndex1) < vntBuffer

                lngIndex1 = lngIndex1 + 1

            Loop

            Do While vntBuffer < SortString(lngIndex2)

                lngIndex2 = lngIndex2 - 1

            Loop

        Else

            Do While SortString(lngIndex1) > vntBuffer

                lngIndex1 = lngIndex1 + 1

            Loop

            Do While vntBuffer > SortString(lngIndex2)

                lngIndex2 = lngIndex2 - 1

            Loop

        End If

        If lngIndex1 < lngIndex2 Then

            Call Move(pvvntIndex:=Item(lngIndex1).ID, _

                opvvntBefore:=Item(lngIndex2).ID)

            Call Move(pvvntIndex:=Item(lngIndex2).ID, _

                opvvntBefore:=Item(lngIndex1).ID)

            lngIndex1 = lngIndex1 + 1

            lngIndex2 = lngIndex2 - 1

        ElseIf lngIndex1 = lngIndex2 Then

            lngIndex1 = lngIndex1 + 1

            lngIndex2 = lngIndex2 - 1

        End If

    Loop Until lngIndex1 > lngIndex2

    If opvvntLBound < lngIndex2 Then Call Sort( _

        opvenmSortOrder, opvvntLBound, lngIndex2)

    If lngIndex1 < opvvntUBound Then Call Sort( _

        opvenmSortOrder, lngIndex1, opvvntUBound)

End Sub



Friend Function Count() As Long

    Count = SingleProduct.Count

End Function



Friend Sub Delete(ByVal pvvntIndex As Variant)

    Call SingleProduct.Remove(pvvntIndex)

End Sub



Public Function Item(ByVal pvvntIndex As Variant) As clsSingleProduct

    Set Item = SingleProduct.Item(pvvntIndex)

End Function



Public Function NewEnum() As IUnknown

    Set NewEnum = SingleProduct.[_NewEnum]

End Function

Auf die Art verwalte ich die Werte des anvisierten Textbox-Arrays. Die Frage ist jetzt, wie ich mir die Textboxen in eigens dafür vorgesehenen Klassen erzeuge und verwalte. Also ich will sie nicht nur mit der newControl-Function erzeugen, sondern auch gleich mit = an eine Klasse übergeben.

Liebe Grüße Guido