Dynamisch verstellbare Userform - Funktionalitätserweiterung

[kathrin-Flint]

Hallo liebe Leute,

anbei habe ich eine in der Größe dynamisch ferstellbare Userform. Was ich bräuchte wäre eine
Funktionalitätserweiterung in der Form, dass sich die in der Userform befindende Textbox ebenfalls
dynamisch mit verändert. Vielen Dank für eure Hilfe.

Code:

Option Explicit

Private Const MResizer = "ResizeGrab"
Private WithEvents m_objResizer As MSForms.Label
Private m_sngLeftResizePos As Single
Private m_sngTopResizePos As Single
Private m_blnResizing As Single

Private Sub m_AddResizer()
    Set m_objResizer = Me.Controls.Add("Forms.label.1", MResizer, True)
    With m_objResizer
        With .Font
            .Name = "Marlett"
            .Charset = 2
            .Size = 14
            .Bold = True
        End With
        .BackStyle = fmBackStyleTransparent
        .AutoSize = True
        .BorderStyle = fmBorderStyleNone
        .Caption = "o"
        .MousePointer = fmMousePointerSizeNWSE
        .ForeColor = RGB(100, 100, 100)
        .ZOrder
        .Top = Me.InsideHeight - .Height
        .Left = Me.InsideWidth - .Width
    End With
End Sub
Private Sub CommandButton1_Click()
    Unload Me
End Sub
Private Sub m_objResizer_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 1 Then
        m_sngLeftResizePos = X
        m_sngTopResizePos = Y
        m_blnResizing = True
    End If
    
End Sub
Private Sub m_objResizer_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 1 Then
        With m_objResizer
            .Move .Left + X - m_sngLeftResizePos, .Top + Y - m_sngTopResizePos
            Me.Width = Me.Width + X - m_sngLeftResizePos
            Me.Height = Me.Height + Y - m_sngTopResizePos
            .Left = Me.InsideWidth - .Width
            .Top = Me.InsideHeight - .Height
        End With
    End If
    
End Sub
Private Sub m_objResizer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        m_blnResizing = False
    End If
End Sub
Private Sub UserForm_Initialize()

    m_AddResizer
    
End Sub
Private Sub UserForm_Terminate()

    Me.Controls.Remove MResizer
    
End Sub
Private Sub UserForm_Click()

End Sub

Code-Tags korrigiert
Moderator [Bild: smilie.php?smile_ID=1810]

[WergibtmirRat]

Hallo

photo Raute_zps3ee56209.jpg

man liest sich :21:

[schauan]

Hallo Kathrin,

hier erst mal ein Ansatz:

Code:

Me.Width = Me.Width + X - m_sngLeftResizePos
            Me.TextBox1.Width = Me.TextBox1.Width + X - m_sngLeftResizePos
            Me.Height = Me.Height + Y - m_sngTopResizePos
            Me.TextBox1.Height = Me.TextBox1.Height + Y - m_sngTopResizePos

Allerdings hat das einen bis zwei Excel-Haken .

Zum einen wird das Textfeld eventuell zu schnell klein. Da könnte man mit einem Faktor gegensteuern, z.B.
=...+ (X - m_sngLeftResizePos) * 0.7.
Besser wäre wohl, das in Abhängigkeit der Maße der Userform zu regeln, also
=Me.Width * 0.5.

Zum anderen kommt von Excel ein Fehler, wenn die Höhe zu gering wird - und wenn Du nur bei der Höhe mit einem Mindestwert gegensteuerst, kommt vielleicht irgendwann ein Fehler bei der Breite.

Du musst also einen Kleinstwert festlegen, z.B.
=...Worksheetfunction.Max(Me.TextBox1.Height + Y - m_sngTopResizePos, Kleinswert).
Kleinstwert dann durch eine entsprechende Zahl ersetzen.

Hier der code mit den Hinweisen:

Code:

Me.Width = Me.Width + X - m_sngLeftResizePos
            Me.TextBox1.Width = WorksheetFunction.Max(Me.Width * 0.5, 20)
            Me.Height = Me.Height + Y - m_sngTopResizePos
            Me.TextBox1.Height = WorksheetFunction.Max(Me.Height * 0.2, 10)

Die zahlen müsstest Du dann so anpassen, wie Du es brauchst.

[kathrin-Flint]

Hallo wergibtmirRat

gerne baue ich den Code wie gewünscht ein. Aber ich habe den Knopf mit der Raute gedrückt.
Was noch oder besser wie geht's genau?!

[WergibtmirRat]

Hallo wergibtmirRat

gerne baue ich den Code wie gewünscht ein. Aber ich habe den Knopf mit der Raute gedrückt.
Was noch oder besser wie geht's genau?!

Hey, schreibe einfach von Hand [_code_] und [_/code_] (ohne Unterstriche) genauso wie das Big Letter [b] ...
oder du hast nach einfügen des Codeteiles den oberen Code nicht gedrückt zum schliessen.

:21:

[schauan]

Hallo Kathrin,

ich hoffe, Du hast auch meine Antwort zum Problem gesehen - wir haben uns ja mit dem Schreiben ziemlich überschnitten :17:

Variante 1
Wenn Du code einfügst, dann drücke vor dem Einfügen auf die Raute, dann fügst Du ein, und dann musst Du nochmal auf die Raute drücken.

Variante 2
Du fügst code ein. Anschließend markierst Du den ganzen code und drückst die Raute

Wenn Du mehrere codes hast und dazwischen Text, dann nimmst Du die "Raute" für jeden codeteil.

[kathrin-Flint]

Danke Leute ich werde mich demnächst dran halten!