Excel VBA Userform Control zur Font Auswahl und Größen-Festlegung

  • VB.NET

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von warbe.

    Excel VBA Userform Control zur Font Auswahl und Größen-Festlegung

    Ich suche ein Control für eine UserForm, die es dem Nutzer erlaubt einen Font aus den verfügbaren auszuwählen und seine Größe festzulegen.
    Gibt es so etwas fertig oder wie kann ich mir es zusammenbauen?

    Hallo.

    Du brauchst für Excel-VBA ein ActiveX-Control. Sowas wird normalerweise in C++ implementiert, geht aber auch in VB.NET. Schau zuerst in die Liste der MS CommonControls - die müsste einen Dialog beinhalten, der FontDialog heißt, soweit ich mich erinnere. Da VBA auf VB 6.0 basiert, sollte dir dieser Link weiterhelfen: msdn.microsoft.com/en-us/library/aa238850%28v=vs.60%29.aspx.
    Gruß
    hal2000

    Es wird ja oft empfohlen, anstatt alte Threads zu verwenden, lieber einen neuen erstellen. Das hat aber auch den Nachteil, dass sehr viele, letztendlich nur bedingt nützliche Ergebisse zu finden sind - so wie hier. Ich habe nähmlich inzwischen eine Lösung wie folgt implementiert, mit der ich sehr zufrieden bin. Ich kann damit nicht nur die Breite der UserForm definieren, sondern auch den Font und dessen Größe und ganz nebenbei natürlich auch den Text der im Antwort-Command-Button steht.

    Visual Basic-Quellcode

    1. Option Explicit
    3. Const sUsrFrm1 As String = "UserForm1" ' The default name of any new UserForm
    4. Const sDynFormName As String = "frmDynMsgBox" ' The name UserForm1 is renamend to
    6. Public Sub DynMsgBox(Optional ByVal sTitle As String = vbNullString, _
    7. Optional ByVal sMsg As String = vbNullString, _
    8. Optional ByVal siWidth As Single = 100, _
    9. Optional ByVal sFont As String = "Calibri", _
    10. Optional ByVal siFontSize As Single = 10, _
    11. Optional ByVal sReplyCaption As String = "Ok", _
    12. Optional ByVal bRemove As Boolean = False)
    13. ' ------------------------------------------------------------------------
    14. ' Dynamically creates a UserForm called 'frmDynMsgBox' with an optional
    15. ' Width ('siWidth), Font ('sFont') and Font Size ('siFontSize').
    16. ' The height is determined by the 'siWidth', the text in 'sMsg' and its
    17. ' format. Please note:
    18. ' When the form is removed with bRemove:=True, any subsequent call within
    19. ' the same procedure or loop will not work unless the Workbook is saved.
    20. ' The reason for this is, that the removal of the Code Module (in this
    21. ' case the UserForm) takes place when the procedure has ended, which
    22. ' contradicts re-using it. Thus, bRemove:=True causes the Workbook being
    23. ' saved - with Application.EnableEvents = False to limit side effects!
    24. ' If this save is inappropriate while the project is active, bRemove:=True
    25. ' should only be used along with Workbook_BeforeClose.
    26. ' ------------------------------------------------------------------------
    27. Dim bEnableEvents As Boolean
    28. Dim vbComp As VBComponent ' The UserForm
    29. Dim pOkButton As MSForms.CommandButton ' The Ok Button
    30. Dim pLabel As MSForms.Label ' The control for the message text
    31. Dim lLines As Long
    32. Dim i As Long ' VBA Code lines counter
    33. Dim siFormCenter As Single ' To center the reply button under the message text
    34. Dim ctl As Variant ' For an astonishing trick !!!
    36. On Error GoTo on_error
    38. If sMsg = vbNullString And bRemove Then GoTo remove_dyn_msg_box
    40. For Each vbComp In ThisWorkbook.VBProject.VBComponents
    41. ' ------------------------------------------------------------
    42. ' Either remove any remainings from previous calls or reuse it
    43. ' ------------------------------------------------------------
    44. With vbComp
    45. If .Name = sDynFormName Then
    47. '~~> Re-use the still existing UserForm
    48. For Each ctl In .Designer.Controls
    49. ' Does something magic since it won't work without it
    50. Next ctl
    51. .Properties("Width") = siWidth + 8
    52. .Properties("Caption") = sTitle
    53. siFormCenter = (siWidth + 8) / 2
    55. Set pLabel = .Designer.Controls("laMsg")
    56. With pLabel
    57. .Font = sFont
    58. .Font.Size = siFontSize
    59. .Caption = sMsg
    60. .AutoSize = False
    61. .Width = siWidth - 5
    62. .AutoSize = True
    63. End With
    65. Set pOkButton = .Designer.Controls("cmbOk")
    66. With pOkButton
    67. '~~> Position the OK-Button along with with the message text width and height
    68. .Top = pLabel.Top + pLabel.Height + 30
    69. .Left = siFormCenter - .Width / 2
    70. End With
    71. .Properties("Height") = pOkButton.Top + pOkButton.Height + 30
    73. GoTo dsply_form
    74. End If
    75. End With
    76. Next vbComp
    78. '~~> Dynamically create the UserForm which does not already exist.
    79. Set vbComp = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
    81. With vbComp
    82. .Properties("Caption") = sTitle
    83. .Properties("Width") = siWidth + 8
    84. siFormCenter = (siWidth + 8) / 2
    85. .Properties("Name") = sDynFormName
    86. .Properties("Height") = 200
    88. Set pLabel = .Designer.Controls.Add("Forms.label.1", "laMsg")
    89. With pLabel
    90. .Font = sFont
    91. .Font.Size = siFontSize
    92. .Caption = sMsg
    93. .Left = 5
    94. .Top = 6
    95. .AutoSize = False
    96. .Width = siWidth - 5
    97. .AutoSize = True
    98. End With
    100. Set pOkButton = .Designer.Controls.Add("Forms.commandbutton.1", "cmbOk")
    101. With pOkButton
    102. .Caption = sReplyCaption
    103. .Top = pLabel.Top + pLabel.Height + 30
    104. .Left = siFormCenter - .Width / 2
    105. End With
    106. .Properties("Height") = pOkButton.Top + pOkButton.Height + 30
    108. With .CodeModule
    109. '~~> Write event code for the reply button(s)
    110. lLines = .CountOfLines
    111. i = 1
    112. .InsertLines lLines + i, "Public Sub cmbOk_Click()": i = i + 1
    113. .InsertLines lLines + i, " Unload Me": i = i + 1
    114. .InsertLines lLines + i, "End Sub"
    115. End With
    116. End With
    118. dsply_form:
    119. VBA.UserForms.Add(vbComp.Name).Show
    121. remove_dyn_msg_box:
    122. If bRemove Then
    123. ' -----------------------------------------------------------
    124. ' Attention! When the UserForm 'frmDynMsgBox' is removed and
    125. ' subsequently called within the same procedure this works
    126. ' only if the Workbook is saved after remove.
    127. ' Since this save may not only be time consuming but also may
    128. ' have unwanted side effects, removing the form is not recom-
    129. ' mendable when this procedure is subsequently called within
    130. ' a procedure but rather along with Workbook_BeforeClose.
    131. ' ------------------------------------------------------------
    132. For Each vbComp In ThisWorkbook.VBProject.VBComponents
    133. If vbComp.Name = sDynFormName Or vbComp.Name = sUsrFrm1 Then
    134. ThisWorkbook.VBProject.VBComponents.Remove vbComp
    135. End If
    136. Next vbComp
    138. '~~> Try to perform the save with minimum side effects possible
    139. With Application
    140. bEnableEvents = .EnableEvents
    141. .EnableEvents = False
    142. ThisWorkbook.Save
    143. .EnableEvents = bEnableEvents
    144. End With
    145. End If
    147. Exit Sub
    149. on_error:
    150. '~~> Remove any dynamically created UserForms
    151. For Each vbComp In ThisWorkbook.VBProject.VBComponents
    152. If vbComp.Name = sDynFormName Or vbComp.Name = sUsrFrm1 Then
    153. ThisWorkbook.VBProject.VBComponents.Remove vbComp
    154. End If
    155. Next vbComp
    157. End Sub


    Die Test-Arbeitsmappe enthält Test-Anwendungsbeispiele. Wenn dieser Code in ein Standard Modul kopiert wird sind noch die beiden Referenzen:
    - Microsoft Forms 2.0 (ggf. erst in der Liste sichtbar, wenn mit Durchsuchen im System32 Verzeichnis die FM20.dll ausgewählt wurde)
    - Microsoft Visual Basic for Aplications Extensibility 5.3
    erforderlich. Andernfalls gibt es einen Fehler "Benutzerdefinierter Typ nicht definiert".

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „warbe“ ()