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.

このマクロは、テキストがページ全体を埋め、すべての単語の間にスペースが 1 つだけあることを確認します。段落構造を保持する必要があります。

このマクロを 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. 検索と置換を実行して、2 つの改行を、ドキュメント内の他の場所にない "0PbEGMySxe3Bz4NOXUcw" のようなランダムな文字列に置き換えます。
  2. 検索と置換を実行して、残りのすべての改行を何も置き換えません
  3. 複数の空白を 1 つの空白に置き換えます (必要に応じて繰り返します)。
  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 に答える