时间戳

首页 > 解决方案 > 在 VBA 中寻找一种方法来拆分 MS Word 中的大量文本以确保它以句点结尾并且少于 280 个字符

vba - 在 VBA 中寻找一种方法来拆分 MS Word 中的大量文本以确保它以句点结尾并且少于 280 个字符

问题描述

我目前正在尝试将大量文本拆分为推文（这是我正在发推文的电子书）。我有将其拆分为 280 个字符块的代码，但我希望它尽可能在一个句点（句号）结束每条推文，同时保持在 280 个字符的限制内。

我对 VBA 很陌生，所以可能有一种更简单的方法来做到这一点。目前，它看起来很适合 Twitter 分成 280 个字符块，但我希望它通过显示为完整的句子来更好地阅读。

Sub SetLineLength()
'Requires setting reference to Microsoft VBScript Regular Expressions 5.5
'Will split at a space UNLESS a single word is longer than LineLength, in 
which
'case it will split at LineLength characters
Const LineLength As Long = 280
Dim RE As RegExp, MC As MatchCollection, M As Match
Dim Ps As Paragraphs, P As Paragraph
Dim i As Long
Dim doc As Document
Dim sIn As String, sOut As String
Set RE = New RegExp
RE.Global = True
Set doc = ActiveDocument

'Replace multiple spaces with one
'Leave paragraphs intact
'Trim to line length
Set Ps = doc.Paragraphs
For i = Ps.Count To 1 Step -1
Set P = Ps(i)
    RE.Pattern = "\s{2,}"
sIn = RE.Replace(P.Range.Text, " ")
    RE.Pattern = "\S.{0," & LineLength - 1 & "}(?=\s|$)|\S{" & LineLength & "}"
If RE.Test(sIn) = True Then
    Set MC = RE.Execute(sIn)
    sOut = ""
    For Each M In MC
        sOut = sOut & M & vbNewLine
    Next M
    P.Range.Text = sOut
End If

'Uncomment for debugging
'    Stop

Next i

End Sub

任何帮助将不胜感激！

标签： vbatwitterms-word

解决方案

您需要 InStrRev 在接下来的 280 个字符中找到最后一个句点的位置。放入一个循环，并用 Mid 将起始位置推进最后一个找到的句点，应该将段落分成 <=280 个字符块。

Option Explicit

Sub tweetThis()

    Dim p As Paragraph, doc As Document
    Dim i As Long, prd As Long, str As String

    Const ll As Long = 280
    ReDim tw(0) As Variant

    Set doc = ActiveDocument

    For Each p In doc.Paragraphs

        str = p.Range.Text & Space(ll)
        prd = InStrRev(str, Chr(46), ll, vbBinaryCompare)

        Do While prd > 0
            ReDim Preserve tw(i)
            tw(i) = Trim(Mid(str, 1, prd))
            i = i + 1
            str = Mid(str, prd + 1)
            prd = InStrRev(str, Chr(46), ll, vbBinaryCompare)
        Loop

    Next p

    For i = LBound(tw) To UBound(tw)
        Debug.Print tw(i)
    Next i

End Sub

推荐阅读