Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Dynamisch verstellbare Userform - Funktionalitätserweiterung
#1
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]


Angehängte Dateien
.xls   Dynamisch verstellbare Userform.xls (Größe: 37 KB / Downloads: 9)
Antworten Top
#2
Hallo

photo Raute_zps3ee56209.jpg

man liest sich :21:
Antworten Top
#3
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 Undecided.

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.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#4
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?!
Antworten Top
#5
(22.08.2014, 19:00)kathrin-Flint schrieb: 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:
Antworten Top
#6
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.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#7
Danke Leute ich werde mich demnächst dran halten!
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste