Question

好的，这就是我想要实现的目标。我有一个带有表单的MS Access 2016数据库 - 其中一个字段是文本字段（最多255个字符），用户可以按日期输入“注释”。

表格是连续的形式，有很多笔记。并且由于大多数音符只有一个句子，而不是完整的255个字符，为了节省屏幕空间，文本框的大小只允许显示两行文本（用户可以双击音符以查看罕见的全文）文本最多255个字符的实例。

这种方法的问题在于，如果一个音符超出这两行，并不总是很清楚。

所以我试图找到一种方法来说明注释在文本框中使用了多少行文本，然后如果是这种情况我会突出显示文本框。

注意我在这里谈论的是文本框中的文本环绕，而不是（必然）带有换行符的文本（尽管也可能有换行符）。鉴于包装更改取决于文本（例如，长词将“尽早”换行到新行），因此即使使用等宽字体，使用简单的字符计数也不起作用。

我在网上搜索了很多，但没有找到任何内容，只不过这里有一个可能的解决方案： http://www.lebans.com/textwidth-height.htm

但下载是我无法再打开的旧的Access文件类型。

有没有人有任何想法（表格重新设计除外 - 这是我最后的选择！）

Answer 1

要计算字符串或文本框中的行数，可以使用以下表达式：

UBound(Split(str, vbCrLf))

所以

UBound(Split([textBoxName], vbCrLf))

Answer 2

好的，我已经提出了一个＆＃34;解决方案＆＃34;对此 - 它既不整洁也不快，但它似乎适用于我的情况。我已经为可能感兴趣的任何人发布了VBA代码。

然后，此函数用于连续表单的文本框条件突出显示，因此我可以突出显示文本已超出＆＃34; n＆＃34;线（在我的例子中，两行）

仅供参考，它只进行了部分测试，没有错误处理！

' Returns TRUE if the text in a textbox wraps/breaks beyond the number of visible lines in the text box (before scrolling)
' THIS ONLY WORKS FOR MONOSPACE FONTS IN A TEXTBOX WHERE WE KNOW THE WidthInMonospaceCharacters
' WidthInMonospaceCharacters = number of MONOSPACE characters to EXACTLY fill one line in your text box (needs to be counted manually
' VisibleLinesInTextBox = number of lines your text box shows on screen (without scrolling)

Function UnseenLinesInTextBox(YourText As String, WidthInMonospaceCharacters As Long, VisibleLinesInTextBox As Long) As Boolean

Dim LineBreakTexts() As String
Dim CleanText As String
Dim LineCount As Long
Dim LineBreaks As Long
Dim i As Long

'   Doesn't matter if we can't see invisible end spaces/line breaks, so lose them
'   NB advise cleaning text whenver data updated then no need to run this line
    CleanText = ClearEndSpacesAndLineBreaks(YourText)

'   Check for any line breaks
    LineBreakTexts = Split(CleanText, vbCrLf)

'   Too many line breaks means we can't be all in the textbox, so report and GTFOOD
    LineBreaks = UBound(LineBreakTexts)
    If LineBreaks >= VisibleLinesInTextBox Then
        UnseenLinesInTextBox = True
        GoTo CleanExit
    End If

'   No line breaks, and text too short to wrap, so exit
    If LineBreaks = 0 And Len(CleanText) <= WidthInMonospaceCharacters Then GoTo CleanExit

'   Loop thorough the line break text, and check word wrapping for each
    For i = 0 To LineBreaks

        LineCount = LineCount + CountWrappedLines(LineBreakTexts(i), WidthInMonospaceCharacters, VisibleLinesInTextBox)

        If LineCount > VisibleLinesInTextBox Then
            UnseenLinesInTextBox = True
            GoTo CleanExit
        End If

    Next i

CleanExit:
    Erase LineBreakTexts


End Function

' Add BugOutLineCount if we are using this simply to see if we are exceeding X number of lines in a textbox
' Put this number of lines here (eg if we have a two line text box, enter 2)
Function CountWrappedLines(YourText As String, WidthInMonospaceCharacters As Long, Optional BugOutLineCount As Long) As Long

Dim SpaceBreakTexts() As String
Dim LineCount As Long, RollingCount As Long, SpaceBreaks As Long, i As Long
Dim WidthAdjust As Long
Dim CheckBugOut As Boolean
Dim tmpLng1 As Long, tmpLng2 As Long

    If BugOutLineCount > 0 Then CheckBugOut = True

'   Check for space breaks
    SpaceBreakTexts = Split(YourText, " ")
    SpaceBreaks = UBound(SpaceBreakTexts)

    If SpaceBreaks = 0 Then

'       No spaces, so text will wrap simply based on the number of characters per line
        CountWrappedLines = NoSpacesWrap(YourText, WidthInMonospaceCharacters)
        GoTo CleanExit

    End If

'   Need to count the wrapped line breaks manually
'   We must start with at least one line!
    LineCount = 1

    For i = 0 To SpaceBreaks

        tmpLng1 = Len(SpaceBreakTexts(i))

        If i = 0 Then
'           Do not count spaces in the first word...
            RollingCount = RollingCount + tmpLng1
        Else
'           ... but add spaces to the count for the next texts
            RollingCount = 1 + RollingCount + tmpLng1
        End If

'       Need this adjustment as wrapping works slightly differently between mid and
'       end of text
        If i = SpaceBreaks Then
            WidthAdjust = WidthInMonospaceCharacters
        Else
            WidthAdjust = WidthInMonospaceCharacters - 1
        End If

'       Check when we get a wrapped line
        If RollingCount > WidthAdjust Then

'           Check the the length of the word itself doesn't warp over more than one line
            If tmpLng1 > WidthInMonospaceCharacters Then
                tmpLng2 = NoSpacesWrap(SpaceBreakTexts(i), WidthInMonospaceCharacters)
                If i <> 0 Then
                    LineCount = LineCount + tmpLng2
                Else
                    LineCount = tmpLng2
                End If
'               As we have wrapped, then we already have a word on the next line to count in the rolling count
                RollingCount = tmpLng1 - ((tmpLng2 - 1) * WidthInMonospaceCharacters)
            Else
'               New line reached
                LineCount = LineCount + 1
'               As we have wrapped, then we already have a word on the next line to count in the rolling count
                RollingCount = Len(SpaceBreakTexts(i))
            End If

        End If

        If CheckBugOut Then If LineCount > BugOutLineCount Then Exit For

    Next i

CountWrappedLines = LineCount

CleanExit:
    Erase SpaceBreakTexts


End Function

' Work out how many lines text will wrap if it has NO spaces
Function NoSpacesWrap(YourText As String, WidthInMonospaceCharacters) As Long

Dim WordLines As Double
Dim MyInt As Integer

    WordLines = (Len(YourText) / WidthInMonospaceCharacters)
    MyInt = Int(WordLines)

'   Line(s) are exact width we are looking at
    If WordLines - MyInt = 0 Then
        NoSpacesWrap = MyInt
    Else
        NoSpacesWrap = MyInt + 1
    End If

End Function

Function ClearEndSpacesAndLineBreaks(YourText As String) As String

Dim str As String
Dim CurrentLength As Long

str = YourText

'   Need to loop this in case we have a string of line breaks and spaces invisibly at end of text
    Do

        CurrentLength = Len(str)

    '   Clear end spaces
        str = RTrim(str)

    '   Clear end line break(s) whihc are TWO characters long
        Do
            If Right(str, 2) <> vbCrLf Then Exit Do
            str = Left(str, Len(str) - 2)
        Loop

        If Len(str) = CurrentLength Then Exit Do

    Loop

ClearEndSpacesAndLineBreaks = str

End Function

请提供任何反馈和意见！

如何计算MS Access表单上文本框中可见的文本行数

2 个答案: