Scrollbars Eigenschaft ändert vorher definierte Objekte.

[Swhh]

Hallo,
 
ich bin gerade dabei eine Benutzer definierte Suchfunktion in einer meiner Dateien einzufügen. Dabei habe ich eine Userform erstellt welche mir die Daten mittels Listboxen anzeigt.
Diese werden dynamisch mittels Code erstellt und in Größe, Form und Ausrichtung auf der Userform platziert. Dadurch dass ich im Vorfeld nicht weiß wie viele Listboxen ich benötige, wollte ich mittels der Scrollbar Eigenschaft der Userform dies kompensieren und die Userform in ihrer Größe fürs erste so belassen.

In der Form wie folgt wollte ich das lösen:

Code:

If Height < ScrollHeight Then ScrollBars = fmScrollBarsVertical Else ScrollBars = fmScrollBarsNone

 Den Wert SrollHeight passe ich innerhalb des Codes jeweils an. Je mehr Listboxen ich erstelle und je Größer diese werden, desto größer wird mein ScrollHeight Wert.
 
In der Theorie Funktioniert das auch alles so weit wie gedacht. Praktisch gesehen sieht das allerdings ein wenig anders aus.
Nun zu meinem Problem:
Wenn ich meinen Code mittels des VB-Editor Debuggers manuell durch laufen lasse (F8 drücken bzw. den Cursor ans Ende des Code setzen und STRG + F8 drücken) funktioniert alles wie gewollt.
Sobald ich allerdings die Sub automatisch ablaufen lasse, ändern die zuvor erstellten Listboxen ihren Width und Heigth Wert von alleine. Wenn ich allerdings wiederum in meinem Code die Zeilen auskommentiere in denen ich die Scrollbar = fmScrollBarsVertical verwende (Am Ende der cmdAlleSuchen_Click Sub), funktioniert wieder alles wie gewollt nur das ich dann eben keine Scrollbar mehr an meiner Userform habe.
 
Hab ich da irgendwas vergessen oder muss ich bei der Scrollbar Eigenschaft irgendwas beachten wenn ich die verändere?


Was noch interresant zu wissen sein dürfte ist folgenden Tatsache: Ich habe in der Userform eine Funktion mit drin welche bei dem Ereigniss UserForm_Resize aufgerufen wird. Darin wird ebenfalls die Scrollbar-Eigenschaft gegebenenfalls verändert.
Wenn diese Prozedur allerdings abläuft bleiben die Width und Height Wert der Listboxen erhalten wie sie in der anderen Prozedur erstellt wurden.
Wenn ich diese Funktioin aber auch innerhalb meiner Prozedur aufrufe in der ich auch die Listboxen erstell werden diese wieder in der Größe verändert.

Einen Grafik Fehler habe ich ebenfalls ausschliesen können. Ich habe die Listboxen einer Klasse zugeordnet in der ich als Probe die Width und Heigth Wert der angeklickten Listbox auswerte. Es kommen dabei jeweils verschieden Werte heraus.

[
Bild bitte so als Datei hochladen: Klick mich!
]
Ergebniss mit ScrollBars Änderung. (Hier ist an der rechten Seite eine Scrollbar zu sehen aber die Darstellung schaut doof aus )

[
Bild bitte so als Datei hochladen: Klick mich!
]
Ergebniss ohne Scrollbars Änderung. (Hier ist keine zu sehen, dafür schaut die Liste gut aus :69: )

Ich hoffe ich konnte mein Problem ausreichend genau schildern.

Mfg Harald

PS: In der Beispiel Datei sind die auskommentierten Zeilen mit    <<<<<<<<< Betroffene Zeile    markiert. (Wenn eine davon aktiv ist entsteht der Fehler bei drücken des "Alle Maschinen Suchen" CommandButton)

[schauan]

Hallöchen,

nur ein Tipp - versuche doch mal, die Listboxen in einen Frame zu platzieren.

[Swhh]

Hi,

mit dem Frame muss ich dir recht geben, das schaut am Ende besser aus.

Allerdings hat es leider nichts an meinem Problem verbessert sondern eher verschlechtert. Jetzt werden die Listboxen selbst dann so dargestellt wie in Bild 1 im ersten Post wenn ich die CodeZeile aus Post 1 ausschalte.
Nehm ich die Zuordnung zum Frame beim erstellen der Listboxen wieder raus geht es dann wieder wenn ich die CodeZeile ausschalte.

[schauan]

Hallöchen,

Du tauschst in der Schleife die "normalen" Listboxen durch Klassenteile aus. Die haben dann irgendein Standardmaß. Passe dort nochmal die Größe an. Seltsam ist nur, dass bei schrittweisem Durchlauf die Boxengröße der ersetzten genommen wird und bei "ungebremsten" Durchlauf diese "komische" Standardgröße.

Code:

 For Each ctrl In Me.Controls
   If TypeOf ctrl Is MSForms.ListBox And Left(ctrl.Name, 11) = "lstMaterial" Then
     Set lstMaterial = New clslstMaterial
     Set lstMaterial.clslstMaterial = ctrl
     collstMaterial.Add lstMaterial
     With lstMaterial.clslstMaterial
       .Width = 340
       .Height = 20
     End With
   End If
 Next ctrl

Dann funktioniert es erst mal.

Eigentlich könntest Du aber auch oben gleich die Klassenlistbox erzeugen statt einer normalen.

[Swhh]

Hi,
danke für die Antwort. Ja das hat das Problem soweit behoben. Danke schon mal dafür!

Ich muss gestehen, das ich die Klassenzuordnung wie in meiner Beispieldatei benutzt, von jemanden anderes abgeschaut habe und meinen Bedürfnissen angepasst habe, daher bin ich nicht auf die Idee gekommen die Zuordnung gleich beim erstellen zu erledigen. Und was soll ich sagen never Change a running System.  :19:


Aber man will ja nicht dumm sterben und deshalb habe ich mal versucht nach meinem Wissenstand beim erstellen der Listbox bereits die Klassenzuordnung vorzunehmen so wie du erwähnt hast.
Ich habe es wie im nachstehen Code versucht. Dabei tritt aber dann wieder der Fehler vom Anfang auf (siehe Bilder erster Post). Habe ich da irgendwas falsch gemacht oder nicht beachtet?
PS: Den Code wie im vorherigen Beitrag habe ich natürlich auskommentiert damit er nicht mehr greift (Muss ja nicht 2 mal zugeordnet werden).

Code:

   Set NewListbox = Me.frmAnzeige.Controls.Add("Forms.Listbox.1", "lstMaterial" & i)
   Set lstMaterial = New clslstMaterial
   Set lstMaterial.clslstMaterial = NewListbox
   collstMaterial.Add lstMaterial
   With NewListbox
     .ColumnCount = 7
     .BackColor = &H80000016
     .Top = 5 + iNaechsterTopWert + iBlockgroesse
     .Height = 12
     .Left = 10
     .Enabled = True
     .AddItem
     For x = 0 To 6
       If x = 0 Then
         .List(0, x) = arrstrMaterialListe(i, 0)
       Else
         .List(0, x) = arrTest(x)
       End If
     Next x
     .ColumnWidths = "60;33;50;55;38;30;60"
     .Width = 450
     .Height = 20
   End With

Mfg Harald

[schauan]

Moin

Kann leider erst Dienstag weiter helfen, bin im Moment nur Smartphone lastig :22:

[schauan]

Hallöchen,

hier mal noch der angepasste Code. Zusätzlich zu dem Sub hab ich drüber noch eine weitere Variable deklariert. Die anderen Deklarationen über dem Sub bleiben wie gehabt.

Code:

Public WithEvents clslstMaterial As MSForms.ListBox

Private Sub cmdAlleSuchen_Click()

  Dim i, x, y, z As Long                                                      'Schleifen Variablen
  Dim iZaehlerMaterial, iZaehlerMaxMaschine As Integer                        'Schleifen Z?hler (iZaehlerMaxMaschine = Die maximale Anzahl an Mschinen bei irgend einem Material)
  Dim iZaehlerMaterialPos, iZaehlerMaschinePos As Integer                     'Schleifen Z?hler Position falls gleiche Werte vorhanden waren
  Dim arrTest(0 To 6) As String                                 'Test Array zum bef?llen der Listboxen
  Dim arrstrMaterialListe(1 To 50, 0 To 15) As String                         'Datenfeld f?r das zu suchende Material
                                                                              '1 to 50 entspricht den verschiedenen Materialnummern incl. Varianten Kennung (Wird in x,0 gespeichert)
                                                                              '0 to 15 entspricht der Maschinenzuordnung; 0= Material Nummer; 1 = erste Maschine; 2 = zweite Maschine; usw.
  Dim iNaechsterTopWert As Integer                                            'Positions ?bergabewert aus der letzten erstellten Materialliste (Falls eine Listbox mehr Zeilen hat als eine andere)
  Dim iBlockgroesse As Integer                                                'Blockgr??en Variable
  Dim strMaschinenReihe As String                                             'Zusammenh?ngender String f?r die Listen Beschriftung
  
  Dim ctrl As MSForms.Control                                                 'Objekt Variable um die neuen Controls der Klasse zuzuordnen
  
  Dim NewLabel As MSForms.Label
  Dim lstMaterial As clslstMaterial
  
  Set collstMaterial = New Collection
  Set colMaterialLabel = New Collection
  
  iZaehlerMaterial = 0
  iZaehlerMaxMaschine = 1
  iZaehlerMaterialPos = 0
  iZaehlerMaschinePos = 0
  
  'Abfrage welches Material an welcher Maschine l?uft
  For i = 1 To 15
    'Erster Durchlauf >>> erstes Material und Maschine (1,0) und (1,1)
    If i = 1 Then
      iZaehlerMaterial = 1
      iZaehlerMaxMaschine = 1
      arrstrMaterialListe(iZaehlerMaterial, 0) = Sheets(1).Cells(15 + i, 31).Value
      arrstrMaterialListe(iZaehlerMaterial, 1) = Sheets(1).Cells(15 + i, 2).Value
    Else
      'Zweiter Durchlauf oder mehr >>> weitere Abfragen n?tig
      'Jeder bisherige Eintrag wird durchlaufen um gleiches Material zu finden
      For x = 1 To i - 1
        'Wenn ja dann Position merken (iZaehlerMaterialPos <> 0)
        If Sheets(1).Cells(15 + i, 31).Value = arrstrMaterialListe(x, 0) Then iZaehlerMaterialPos = x
      Next x
      'Wenn gleiches Material gefunden wurde muss die Anzahl an bereits daf?r gemrkten Maschinen ermittelt werden
      If iZaehlerMaterialPos <> 0 Then
        'Abfrage ab Position 2 da Position 1 bereits schon vorhanden sein muss bis Maximale Anzahl +1 falls n?tig
        For y = 2 To iZaehlerMaxMaschine + 1
          'Wenn Position leer dann Position merken
          If arrstrMaterialListe(iZaehlerMaterialPos, y) = "" Then
            iZaehlerMaschinePos = y
            'Wenn die ermittelte Position eine neue maximale Anzahl ergibt (Weil letzter Schleifen durhclauf) dann wird hier angepasst
            If y = iZaehlerMaxMaschine + 1 Then iZaehlerMaxMaschine = y
            'Wenn nicht wird die Schleife vorzeitig abgebrichen
            Exit For
          End If
        Next y
      End If
      
      'Daten?bernahme in Variablen Feld
      If iZaehlerMaterialPos <> 0 Then
        'Wenn eine Position ermittelt wurde ist das Material bereits erfasst worden
        arrstrMaterialListe(iZaehlerMaterialPos, iZaehlerMaschinePos) = Sheets(1).Cells(15 + i, 2).Value
      Else
        'Wenn keine Position ermittelt wurde muss der Materialz?hler um 1 erh?ht werden
        iZaehlerMaterial = iZaehlerMaterial + 1
        arrstrMaterialListe(iZaehlerMaterial, 0) = Sheets(1).Cells(15 + i, 31).Value
        arrstrMaterialListe(iZaehlerMaterial, 1) = Sheets(1).Cells(15 + i, 2).Value
      End If
    End If
    iZaehlerMaterialPos = 0
    iZaehlerMaschinePos = 0
  Next i
  
  lstAnzeige.Visible = False
  
  arrTest(0) = "16-01"
  arrTest(1) = "1"
  arrTest(2) = "ART 23"
  arrTest(3) = "12345"
  arrTest(4) = "11"
  arrTest(5) = "15"
  arrTest(6) = "gesperrt"
  
  strMaschinenReihe = ""
  iBlockgroesse = 0
  iNaechsterTopWert = 0
  
  For i = 1 To iZaehlerMaterial
    For x = 1 To iZaehlerMaxMaschine
      If arrstrMaterialListe(i, x) = "" Then
        Exit For
      Else
        If x = 1 Then
          strMaschinenReihe = arrstrMaterialListe(i, x)
        Else
          strMaschinenReihe = strMaschinenReihe & ", " & arrstrMaterialListe(i, x)
        End If
        iZaehlerMaterialPos = x
      End If
    Next x
    
    Set NewLabel = Me.Controls.Add("FORMS.Label.1", "lblMaterial" & i)
    With NewLabel
      .Top = 90 + iNaechsterTopWert
      .Height = 15
      .Left = 80
      .Width = 350
      .Caption = "L?uft an folgenden Maschinen: " & strMaschinenReihe
    End With
    iBlockgroesse = 15
    Set NewLabel = Me.Controls.Add("Forms.Label.1", "lblMaterialUeberschrift" & i)
    With NewLabel
      .Top = 90 + iNaechsterTopWert + iBlockgroesse
      .Height = 12
      .Left = 25
      .Width = 350
      .Caption = "Material      Stellplatz   Bezeichnung           Charge          KG      Oktabin       Status"
    End With
    iBlockgroesse = iBlockgroesse + 12
    
    'Set lstMaterial = New clslstMaterial
    Set clslstMaterial = Me.Controls.Add("Forms.Listbox.1", "lstMaterial" & i)
    With clslstMaterial
      .ColumnCount = 7
      .BackColor = &H80000016
      .Top = 90 + iNaechsterTopWert + iBlockgroesse
      '.Height = 12
      .Left = 10
      .Enabled = True
      .AddItem
      For x = 0 To 6
        If x = 0 Then
          .List(0, x) = arrstrMaterialListe(i, 0)
        Else
          .List(0, x) = arrTest(x)
        End If
      Next x
      .ColumnWidths = "60;33;50;55;38;30;60"
      .Width = 340
      .Height = 20
    End With
    collstMaterial.Add clslstMaterial
    
    iBlockgroesse = iBlockgroesse + 30
    iNaechsterTopWert = iNaechsterTopWert + iBlockgroesse
    iBlockgroesse = 0
    strMaschinenReihe = ""
  
  Next i
  If iNaechsterTopWert + 90 >= ScrollHeight Then ScrollHeight = iNaechsterTopWert + 95
  'If Height < ScrollHeight Then ScrollBars = fmScrollBarsVertical Else ScrollBars = fmScrollBarsNone                 '<<<<<<<<< Betroffene Zeile
  
  Erase arrstrMaterialListe()

  Me.ScrollHeight = iNaechsterTopWert + 95
  Me.ScrollWidth = 350
  'ScrollBars = fmScrollBarsVertical                                                                                 '<<<<<<<<< Betroffene Zeile
  'ScrollBars_Anpassen                                                                                               '<<<<<<<<< Betroffene Zeile
End Sub

[Swhh]

Hi,

dein Vorschlag funktioniert soweit.
Wenn ich allerdings wieder folgende CodeZeile aktiviere (In deinem Beispiel war sie auskommentiert) dann hab ich wieder das Problem das es meine Listboxen verschiebt wie am Anfang. 

Code:

 'If Height < ScrollHeight Then ScrollBars = fmScrollBarsVertical Else ScrollBars = fmScrollBarsNone                 '<<<<<<<<< Betroffene Zeile

Lass ich es aber weg ist die Scrollbar nicht vorhanden und ich kann nicht alle Einträge sehen.

Ich denke ich lass es wie weiter oben und mach die Klassenzuordnung weiter unten seperat. Da hat es zumindest funktioniert, warum auch immer es nicht geht wenn man es direkt oben einbettet. Das entzieht sich komplett meiner Logik, insbesonders weil es ja im Manuellen Durchlauf funktioniert ^^

Trotzdem nochmal danke für deine Hilfe!

Mfg Harald