以编程方式访问 VBA 设置字体/大小不起作用

Question

我有一个按钮，可以将文本框的字体和大小更改为 Tahoma 8pt。按钮事件是：

Private Sub btnSetFont_Click()
    MsgBox ("Setting Inventory Description to Tahoma 8pt")
    Me.InventoryDescription.FontSize = 8
    Me.InventoryDescription.FontName = "Tahoma"
End Sub

不幸的是，文本没有改变。我正在测试它，首先手动编辑字体和大小，然后按下我的按钮。

但是，如果我执行以下操作，

Private Sub btnSetFont_Click()
    MsgBox ("Setting Inventory Description to Tahoma 8pt")
    Me.InventoryDescription.Value = "hello"
    Me.InventoryDescription.FontSize = 24
    Me.InventoryDescription.FontName = "Times"
End Sub

文本当然会变成“hello”，但字体和大小确实会发生变化。 （我使用 Times 24pt，因为文本框的默认值是 Tahoma 8pt，我想确保它不只是恢复到默认值）这让我认为文本框需要有焦点才能进行更改。所以，我尝试了：

Private Sub btnSetFont_Click()
    MsgBox ("Setting Inventory Description to Tahoma 8pt")
    Me.InventoryDescription.SetFocus
    Me.InventoryDescription.FontSize = 24
    Me.InventoryDescription.FontName = "Times"
End Sub

但是，不行。

Soooo，我做错了什么？

---

我发现了问题的一个方面。文本框 .TextFormat 设置为 Rich Text。如果我将其更改为纯文本，则按钮效果有效。但是，将其设置为富文本的原因是允许斜体。因此，我尝试先将其设置为纯文本，然后更改字体/大小，但这也不起作用。

Answer 1

我有同样的需求：我希望用户能够使用粗体、斜体和下划线字符来格式化文本，但我不想允许更改字体名称或更改字体大小。并且复制/粘贴操作通常会在我的 textBox 中导入格式化文本，这需要“清理”。

我找到的解决方案在下面的函数中。 此函数应由事件过程调用（即更新后或单击时）。

---

Public Function CleanRichText(strTEXT, strFont, nSize)
'*****************************************************
' 

    For i = 1 To 9
        strTEXT = Replace(strTEXT, "size=" & i, "size=" & nSize)
    Next i

    strTEXT = Replace(strTEXT, "font face", "font_face")
    strTEXT = Replace(strTEXT, "font" & Chr(13) & Chr(10) & "face", "font_face")

    Do While InStr(1, strTEXT, "font_face=" & Chr(34)) > 0
        iCut1 = InStr(1, strTEXT, "font_face=" & Chr(34))
        iCut2 = InStr(iCut1 + 12, strTEXT, Chr(34))
        strLeft = Left(strTEXT, iCut1 - 1) & "font_face=Face"
        strRight = Right(strTEXT, Len(strTEXT) - iCut2)
        strTEXT = strLeft & strRight
    Loop

    Do While InStr(1, strTEXT, "font_face=") > 0
        iCut1 = InStr(1, strTEXT, "font_face=")
        iCut2 = InStr(iCut1 + 12, strTEXT, Chr(32))
        strLeft = Left(strTEXT, iCut1 - 1) & "font face=" & strFont & Chr(32)
        strRight = Right(strTEXT, Len(strTEXT) - iCut2)
        strTEXT = strLeft & strRight
    Loop
    CleanRichText = strTEXT

End Function

---

Private Sub Cause_AfterUpdate()

    Me.Cause = CleanRichText(Me.Cause, Me.Cause.FontName, 2)
End Sub

Answer 2

您的代码对我有用。更改字体后尝试添加Me.Repaint。

Answer 3

您的代码使用 Access 2010 为我工作。

我将此代码添加到几个命令按钮的单击事件中，这些命令按钮允许用户动态控制名为教师列表的列表框中的字体大小。

Private Sub cmdDecreaseFont_Click()
     Me.teachersList.FontSize = Me.teachersList.FontSize - 1
End Sub

Private Sub cmdIncreaseFont_Click()
    Me.teachersList.FontSize = Me.teachersList.FontSize + 1
End Sub

然后在表单中添加了几个简单的命令按钮

Answer 4

我开始使用@yves 解决方案，但是当“字体”标签包含“大小”属性时它会失败，例如：

<font face="Arial" size="5">a colour in it will break?</font>

所以我找到了使用#RegExp 的更好方法，你可以关注这个论坛的帖子：accessforums.net

Public Function CleanRichTextRegEx(ByVal strText As String, _
                               ByVal strFont As String, _
                               ByVal nSize As Integer) As String
    Dim objRegEx As Object
    Set objRegEx = CreateObject("VBScript.RegExp")
    On Error Resume Next
    With objRegEx
       .Global = True
       'Replace font size
       .Pattern = "size=[0-9]"
       strText = .Replace(strText, " size=" & nSize)
       'Replace font face
       .Pattern = "face=([""'])(?:[\r\n]*(?=(\\?))\2.)*?\1"
       strText = .Replace(strText, "face=" & strFont)
    End With
    Set objRegEx = Nothing
    CleanRichTextRegEx = strText
End Function

你可以这样使用它：

richText = "<font face='Arial' size='5'>a colour in it will break?</font>" 
richTextResult = CleanRichTextRegEx(richText, "Arial", 2)