>

이전에 게시 한 문제 (링크는 아래에 있음)로 아무도 나를 도울 수 없었기 때문에 이제 VBA를 통해 작업을 해결하려고합니다.

찾기 단어 파일의 제목과 그 이후의 전체 단락을 파이썬으로 새 단어 파일로 복사

간단히 요약하면, 많은 양의 워드 파일이 있으며, 각각 더 읽기 쉬운 크기로 줄이려고합니다. 각 파일에는 항상 '제목 2'로 서식이 지정된 제목이 여러 번 나타납니다. 문서에서 여러 번 발생하는이 특정 제목을 찾고 해당 장과 함께이 장의 모든 텍스트 부분을 새 단어 문서로 복사하려고합니다.

복사하려는 챕터의 파일과 각 제목을 나열하는 Excel 파일을 만들기로 결정했습니다 (아래 그림 참조).

이 작업을하기 위해 다음 코드를 작성했습니다 :

Sub SelectData()
    Application.ScreenUpdating = False
    Dim WdApp As Word.Application
    Set WdApp = CreateObject("Word.Application")
    Dim Doc As Word.Document
    Dim NewDoc As Word.Document
    Dim HeadingToFind As String
    Dim ChapterToFind As String
    Dim StartRange As Long
    Dim EndRange As Long
    Dim WkSht As Worksheet
    Dim LRow As Long
    Dim i As Long
    Set WkSht = ThisWorkbook.Sheets("Sheet1")
    LRow = WkSht.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
    With WkSht
        For i = 1 To LRow
            If Dir(.Cells(i, 1).Text, vbNormal) = "" Then
                .Cells(i, 3).Value = "Please check File Location"
            Else
                Set Doc = WdApp.Documents.Open(Filename:=.Cells(i, 1).Text, _
                AddToRecentFiles:=False, Visible:=False, ReadOnly:=False)
                Set NewDoc = Documents.Add
                ChapterToFind = LCase(.Cells(i, 2).Text)
                    With Doc
                    Selection.HomeKey Unit:=wdStory
                        With Selection
                            With .Find
                                .ClearFormatting
                                .Text = ChapterToFind
                                .MatchWildcards = False
                                .MatchCase = True
                                .Execute
                            End With
                            If .Find.Found Then
                                .Collapse wdCollapseStart
                                With .Find
                                    .Text = ""
                                    .Style = "Heading 2"
                                    .Forward = False
                                    .Execute
                                End With
                                .MoveDown Count:=1
                                .HomeKey Unit:=wdLine
                                StartRange = .Start

                                .Find.Forward = True
                                .Find.Execute
                                .Collapse wdCollapseStart
                                .MoveUp Count:=1
                                .EndKey Unit:=wdLine
                                EndRange = .End
                                Doc.Range(StartRange, EndRange).Copy
                                NewDoc.Content.Paste
                                NewDoc.SaveAs2 Doc.Path & "Clean" & ".docx", wdFormatFlatXML
                            Else
                                WkSht.Cells(i, 4).Value = "Error Chapter Not Found"
                            End If
                        End With
                End With
                WdApp.Quit
                Set Doc = Nothing: Set NewDoc = Nothing: Set WdApp = Nothing: Set WkSht = Nothing
                Application.ScreenUpdating = True
            End If
        Next
    End With
End Sub

그러나 나는 정말로 고투하고있다. 명령 (RunTimeError 438)에 계속 오류가 발생하여 작동하지 않는 것 같습니다 :

Selection.HomeKey Unit:=wdStory

단어 명령을 얻으려면 참조에서 Microsoft Word 15.0 Object Library를 활성화해야한다는 것을 알고 있습니다. 그럼에도 불구하고 작동하지 않습니다.

도움을 주시면 감사하겠습니다. 물론 다른 제안도 가능합니다.

단어 파일은 아래 그림과 비슷하지만 추출하려는 장이 한 워드 문서 내에서 여러 번 발생할 수 있습니다. 결과적으로 내 코드에는 루프 또는 무언가가 필요할 수 있으므로이 작업을 수행 할 수 없었습니다.

또한이 주제에 대한 다음 링크를 고려했습니다.

Powerpoint와 함께 VBA를 사용하여 Word Doc에서 제목을 검색하고 다른 Word 문서로 텍스트 복사

VBA : Excel에서 열린 단어

단어 vba : 제목 사이의 텍스트 선택

  • 답변 # 1

    이것을 올바르게 이해 했습니까? 다음 코드는 내가 생각하는 것의 핵심입니다. 첫 번째 제목 2를 찾은 다음 모든 유형의 다른 머리글이나 문서 끝을 찾을 때까지 모든 단락을 찾습니다. startCopyRange 및 endCopyRange는 해당 단락의 범위입니다. 이 작업을 Excel 루틴에 포함시켜야합니다.

    몇 가지 메모. 항상 활성 문서를 변수에 저장하고 그로부터 작업하십시오. 그런 다음이 루틴이 실행되는 동안 사용자는 활성 문서를 자유롭게 변경할 수 있습니다. 선택을 사용하지 말고 항상 범위를 사용하십시오. 이동과 같은 상대 이동을 사용하지 말고 항상 API 호출을 사용하십시오.

    Sub SelectData()
        Dim Doc As Word.Document
        Set Doc = ActiveDocument
        Dim findRange As Range
        Set findRange = Doc.Range
        ChapterToFind = "My Chapter"
        findRange.Find.Text = ChapterToFind
        findRange.Find.Style = "Heading 2"
        findRange.Find.MatchCase = True
        Dim startCopyRange As Long
        Dim endCopyRange As Long
        Do While findRange.Find.Execute() = True
            startCopyRange = findRange.End + 1
            endCopyRange = -1
            'findRange.Select
            Dim myParagraph As Paragraph
            Set myParagraph = findRange.Paragraphs(1).Next
            Do While Not myParagraph Is Nothing
                myParagraph.Range.Select 'Debug only
                If InStr(myParagraph.Style, "Heading") > 0 Then
                    endCopyRange = myParagraph.Range.Start - 0
                End If
                If myParagraph.Next Is Nothing Then
                    endCopyRange = myParagraph.Range.End - 0
                End If
                If endCopyRange <> -1 Then
                    Doc.Range(startCopyRange, endCopyRange).Select  'Debug only
                    DoEvents
                    Exit Do
                End If
                Set myParagraph = myParagraph.Next
                DoEvents
            Loop
        Loop
    End Sub
    
    

  • 이전 의사 결정 트리 및 의사 결정 포리스트에 대해 Azure ML에서 런타임을 줄이는 방법
  • 다음 node modules - node_modules에 대한 종속성을 포함하는 Lambda