Office: (Office 2019) Listbox wird nicht breiter, Schriftgrösse ändert sich

Hallo,
ich habe ein Formular dessen Breite ich mit der Maus ändern kann. Im Formular habe ich einen Rahmen und darin eine Listbox deren Breite an die Formularbreite angepasst wird.
Me.Frame_Listen.Width = Me.InsideWidth
Me.lst_Umsaetze.Width = Me.Frame_Listen.Width - Me.lst_Umsaetze.Left - Me.lst_Umsaetze.Left
Das funktioniert sehr gut wenn ich den Kode schrittweise ausführe.
Das Bild zeigt den korrekten rechten Rand der Listbox. Gelb ist der Hintergrund des Rahmens.
Lasse ich den Kode aber ohne Debugger laufen treten 2 Probleme auf:
1. die Listbox wird nicht mehr breiter
2. Manchmal wird die Schrift deutlich kleiner oder größer . Die Größe wird aber nicht per Kode geändert.
Repaint am Ende der Sub hat nicht geholfen. Hat jemand eine Idee was hier das Problem ist?

 

Moin Wilhelm,

versuch doch mal, die Listbox-Größe in Relation zur USF zu definieren (Listbox.width = usf.width * 0.8), entsprechend die Texte. Den entsprechenden Event (Repaint) kann ich Dir ohne offenes XL im Moment nicht nennen. Da geht es wohl um die Eigenschaften der Comps im USF-Initialize.

Grüße

 

Moin!
Dann zeige doch mal die Datei.

Gruß Ralf

 

Hallo,
ich berechne die Breite wie vorgeschlagen jetzt mit
Me.lst_Umsaetze.Width = Me.Frame_Listen.Width * 0.95
Leider keine Änderung, beide Probleme sind noch vorhanden.

Die Datei enthält vertrauliche Informationen, kann also leider nicht geteilt werden.
In einem anderen Formular habe ich mehrere Buttons, dort funktioniert die Änderung der Breite.
Hat jemand ein funktionierendes Beispiel für eine Listbox? Evtl. liegt ja ein Problem mit der Listbox vor.
In einem Access Formular funktioniert die Anpassung der Listbox.

 

Hallo,

packe paar anonymisierte Daten in die Tabelle, aus welcher die Listbox gefüllt wird und lade diese Datei hoch. Dann kann man schauen und helfen.

Gruß Uwe

 

Hallo,

Ich vermute mal, dass du FormFun.xls versucht hast deinen Vorstellungen anzupassen?

Gruß Uwe

 

Hallo,
ja, Formfun war die Grundlage. Ich habe eine neue Datei erzeugt und konnte das Problem eingrenzen. Wenn nur die Listbox angepasst wird gibt es kein Problem. Wird zusätzlich auch die Breite der Spalten angepasst,treten die Probleme auf.

 

Hallo,

für die Spaltenbreite so:

Code:

Option Explicit
    Dim arrSp


Private Sub UserForm_Initialize()
    Dim lngLetzteZeile As Long
   
    GetWindowHandle Me
    MakeWindowResizeable

    Me.lst_Daten.Clear
    lngLetzteZeile = ThisWorkbook.Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
    With ThisWorkbook.Worksheets("Daten")
        Me.lst_Daten.RowSource = .Range(.Cells(1, 1), .Cells(lngLetzteZeile, 3)).Address(External:=True)
    End With
    arrSp = Split(lst_Daten.ColumnWidths, ";")
End Sub

Private Sub UserForm_Resize()
    Dim iSp#, i&
   
    Me.lst_Daten.Width = Me.InsideWidth - Me.lst_Daten.Left - Me.lst_Daten.Left
    iSp = Me.lst_Daten.Width / (UBound(arrSp) + 1)

    With Me.lst_Daten
        .Height = Me.InsideHeight - Me.lst_Daten.Top - 20
        For i = LBound(arrSp) To UBound(arrSp)
            arrSp(i) = iSp
        Next i
        .ColumnWidths = Join(arrSp, "; ")
    End With
End Sub

Gruß Uwe

 

Hallo,
ich habe den Murks in den API Funktionen mal noch in Ordnung gebracht. Mit falschen Paramern kann es schnell zu Problemen kommen.
korrigiert so im Modul1:

Code:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If

Private Const GWL_STYLE As Long = (-16)             'offset of a window's style: -16 = 0xFFFF FFFF FFFF FFF0
Private Const GWL_EXSTYLE As Long = (-20)           'offset of a window's extended style: -20 = 0xFFFF FFFF FFFF FFEC
Private Const WS_THICKFRAME As Long = &H40000       'style to add a sizable frame: 262144 = 0x0004 0000

#If VBA7 Then
    Dim mhWndForm As LongPtr
#Else
    Dim mhWndForm As Long
#End If

Public Sub Formular_Oeffnen()
    Load frm_Main
    frm_Main.Show vbModal
End Sub

Public Sub GetWindowHandle(objForm As Object)
    If Val(Application.Version) < 9 Then
        mhWndForm = FindWindow("ThunderXFrame", objForm.Caption)    ' Excel 97 und älter
    Else
        mhWndForm = FindWindow("ThunderDFrame", objForm.Caption)    ' Excel 2000 und neuer
    End If
End Sub

Public Sub MakeWindowResizeable()
#If VBA7 Then
    Dim lngWindowStyle As LongPtr
#Else
    Dim lngWindowStyle As Long
#End If
    If mhWndForm = 0 Then Exit Sub
    
    lngWindowStyle = GetWindowLong(mhWndForm, GWL_STYLE)        'Get the basic window style: -1798832000 = 0xFFFF FFFF 94C8 0080
    lngWindowStyle = UpdateStyle(lngWindowStyle, WS_THICKFRAME, True)      'Build up the basic window style flags for the form
#If VBA7 Then
    SetWindowLongPtr mhWndForm, GWL_STYLE, lngWindowStyle          'Set the basic window styles
#Else
    SetWindowLong mhWndForm, GWL_STYLE, lngWindowStyle          'Set the basic window styles
#End If
    lngWindowStyle = GetWindowLong(mhWndForm, GWL_EXSTYLE)      'Get the extended window style
End Sub

#If VBA7 Then
    Private Function UpdateStyle(ByVal lngWindowStyle As LongPtr, ByVal lngBit As Long, ByVal blActivate As Boolean) As LongPtr
        'Procedure to set or clear a bit from a style flag
        If True = blActivate Then
            UpdateStyle = lngWindowStyle Or lngBit
        Else
            UpdateStyle = lngWindowStyle And Not lngBit
        End If
    End Function
#Else
    Private Function UpdateStyle(ByVal lngWindowStyle As Long, ByVal lngBit As Long, ByVal blActivate As Boolean) As Long
        'Procedure to set or clear a bit from a style flag
        If True = blActivate Then
            UpdateStyle = lngWindowStyle Or lngBit
        Else
            UpdateStyle = lngWindowStyle And Not lngBit
        End If
    End Function

#End If

Gruß Uwe

 

Hallo Uwe,
vielen Dank für die Hilfe! Die Änderungen habe ich alle eingebaut. In meiner Testdatei funktioniert alles, auch mit unterschiedlich breiten Spalten. In der Originaldatei funktioniert nun die Änderung der Spaltenbreite, die Listbox wird aber nicht immer in der Breite geändert. Ich habe die Originaldatei abgespeckt und mit Dummy Daten gefüllt, siehe Anhang. Auch Löschen der Listbox und neu einfügen hat nicht geholfen.

 

Hallo,

die API Funktionen und deren Parameter um die Bildschirmauflösung sind wieder falsch. Mit PtrSafe ist sowas fast nie allein geklärt. Ich hatte dich schon darauf hingewiesen, da es u.U. zu Problemen kommen kann.

Im Netz gibt es API-Viewer wo man die passenden Funktionen nebst den dazugehörigen Parametern abfragen kann.

Eine Anmerkung zu Variablen und deren Deklaration in VBA:
Halte Variablen besser kurz. Das lässt sich für außenstehende einfache besser lesen.
Zählvariablen wie Integer werden intern in Long berechnet also reicht As Long.

Gruß Uwe

 

Hallo Uwe,
ich habe den Kode noch einmal kontrolliert aber ich kann keinen Unterschied finden. Wo ist bitte mein Fehler?

 

hier auszugsweise eine API Funktion zum Vergleich (Modul Monitor):
falsch:
Public Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
richtig:
Public Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long

Gruß Uwe

 

Hallo Uwe,
ich habe die API Funktionen im Modul Monitor korrigiert, anbei die neue Datei.
Leider ist das Problem noch vorhanden.

 

Hallo Wilhelm1,

das ist falsch, was du gemacht hast. Stichwort API-Viewer Hast du das überlesen oder ignoriert?
Hier noch ein Vergleich.
falsch:
Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As Long
richtig:
Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr

Beachte auch die sich aus diesen Änderungen ergebenden Variablendeklarationen, welche u.U. LongPtr oder manchmal auch LongLong deklariert sein müssen.

Habe etwas Geduld und Ausdauer bei der Richtigstellung dieser Dinge.

So lang noch solche Sachen nicht sauber arbeiten, macht es wenig Sinn dies Sache weiterzubauen.

Gruß Uwe