0

我正在尝试编写一个将格式化文本的宏。

这是原始数据的样子：

  This is sentence one of paragraph one. This is 
     sentence two of paragraph one. This is 
    sentence three of paragraph one. This is sentence 
    four of paragraph one. This is sentence five of 
    paragraph one.

  This is sentence one of paragraph two. This is 
    sentence two of paragraph two. This is 
      sentence three of paragraph two. This is sentence 
      four of paragraph two. This is sentence five of 
   paragraph two.

这就是我希望文本的样子：

This is sentence one of paragraph one. This is sentence two of paragraph one. This is  
sentence three of paragraph one. This is sentence four of paragraph one. This is 
sentence five of paragraph one.

This is sentence one of paragraph two. This is sentence two of paragraph two. This is  
sentence three of paragraph two. This is sentence four of paragraph two. This is 
sentence five of paragraph two.

该宏将确保文本填满整个页面，并且每个单词之间只有一个空格。它需要保留段落结构。

我从 Excel 调用此宏并从 Word 运行可读性统计信息。

这是我到目前为止的代码：

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Sub Test_Button1()

    Dim file As String
    Dim StatText As String
    Dim rs As Variant
    Dim row_count As Integer
    Dim header_count As Integer

    row_count = 0
    header_count = 0

    Sheets("Sheet1").Select
    Range("B5").Select

    Set appWD = New Word.Application
    appWD.Visible = True

    Do Until IsEmpty(ActiveCell)
        row_count = row_count + 1
        OpenClipboard (0&)
        EmptyClipboard
        CloseClipboard
        ActiveCell.Copy
        appWD.Documents.Add
        appWD.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
        appWD.ActiveDocument.Select
        With appWD.Selection.ParagraphFormat
            .SpaceBefore = 0
            .SpaceAfter = 0
            .LineSpacingRule = wdLineSpaceSingle
            .WidowControl = False
            .KeepWithNext = False
            .KeepTogether = False
            .PageBreakBefore = False
        End With

        If row_count = 1 Then
           ActiveCell.Offset(-1, 0).Select
           For Each rs In appWD.ActiveDocument.readabilitystatistics
               header_count = header_count + 1
               ActiveCell.Offset(0, 1).Select
               ActiveCell.Value = rs.Name
           Next rs
           ActiveCell.Offset(1, -header_count).Select
        End If

        For Each rs In appWD.ActiveDocument.readabilitystatistics
            ActiveCell.Offset(0, 1).Select
            ActiveCell.Value = rs.Value
            StatText = StatText & rs.Name & " - " & rs.Value & vbCr
        Next rs

        appWD.ActiveDocument.Select
        appWD.Selection.Delete
        appWD.ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges
        ActiveCell.Offset(1, -header_count).Select
    Loop

    appWD.Quit SaveChanges:=wdDoNotSaveChanges    
    Set appWD = Nothing    
End Sub
4

3 回答 3

2
  1. 运行搜索和替换，用随机字符串（如“0PbEGMySxe3Bz4NOXUcw”）替换双换行符，该字符串不会出现在文档的其他任何地方。
  2. 运行搜索和替换替换所有剩余的换行符
  3. 用一个空格替换多个空格（根据需要重复）。
  4. 根据需要将步骤 1 中的随机字符串替换为段落/换行符。

如果您不想查找如何以编程方式进行搜索和替换，您可以使用内置的宏记录器记录这些操作，然后调整代码以适合您的程序。

结果是：

Sub test()
'
' test Makro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\n\n"
        .Replacement.Text = "asdfasdfasdf"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "\n"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "  "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "asdfasdfasdf"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

你显然想在使用它之前清理它，并重复空白搜索和替换，直到什么都没有（例如，只需运行它 10 次，它是指数级的，这就足够了）。

于 2013-01-28T03:32:49.497 回答
0

你可以尝试这样的事情：

Sub CleanWordDocument()

    Dim objWord As Word.Application, objDoc As Word.Document, c As Word.Range

    Set objWord = New Word.Application
    objWord.Visible = True
    Set objDoc = objWord.Documents.Open("C:\Users\user\Documents\test1.docx")

    Set c = objWord.ActiveDocument.Content
    c.ParagraphFormat.Alignment = wdAlignParagraphJustify

    With c.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "  "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        .Execute Replace:=wdReplaceAll
        While .Found
            .Execute Replace:=wdReplaceAll
        Wend
    End With

    objDoc.Save
    objWord.Quit wdDoNotSaveChanges
    Set objWord = Nothing
End Sub
于 2013-01-28T05:48:38.140 回答
0

子宏1()

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "^p "
    .Replacement.Text = "^p"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute

Loop
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Underline = wdUnderlineSingle
With Selection.Find
    .Text = "^p^p"
    .Replacement.Text = "^&"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.Underline = wdUnderlineNone
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "^p"
    .Replacement.Text = " "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "^p^p"
    .Replacement.Text = "^p"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
 Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "  "
    .Replacement.Text = " "
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute
Do While Selection.Find.Found
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute

Loop

结束子

于 2013-04-11T08:04:11.487 回答