VBA를 사용하여 Word에서 Excel로 텍스트 가져 오기

Question

지금까지 문서를 구문 분석하고 두 제목 사이에 제목, 제목 및 텍스트를 가져 오는 작업 코드가 있습니다. 내가 추출하려고하는 내용은 글 머리 기호, 줄 바꿈 등이 있으며 셀에 붙여 넣을 때 형식을 유지하고 싶습니다. 주변을 둘러보고 많은 포럼을 읽었지 만 서식을 그대로 유지하는 방법을 찾아 낼 수 없었습니다. PasteSpecial을 살펴 봤지만 여러 셀에 걸쳐 내용을 붙여 넣었습니다. 가능한 경우 복사/붙여 넣기를 피하고 싶습니다.

Sub GetTextFromWord() 

Dim Paragraph As Object, WordApp As Object, WordDoc As Object 
Dim para As Object 
Dim paraText As String 
Dim outlineLevel As Integer 
Dim title As String 
Dim body As String 
Dim myRange As Object 
Dim documentText As String 
Dim startPos As Long 
Dim stopPos As Long 
Dim file As String 
Dim i As Long 
Dim category As String 

startPos = -1 
i = 2 

Application.ScreenUpdating = True 
Application.DisplayAlerts = False 


file = "C:\Sample.doc" 
Set WordApp = CreateObject("Word.Application") 
WordApp.Visible = True 
Set WordDoc = WordApp.Documents.Open(file) 

Set myRange = WordDoc.Range 
documentText = myRange.Text 

For Each para In ActiveDocument.Paragraphs 
    ' Get the current outline level. 
    outlineLevel = para.outlineLevel 

    ' Cateogry/Header begins outline level 1, and ends at the next outline level 1. 
    If outlineLevel = wdOutlineLevel1 Then 'e.g., 1 Header 
     category = para.Range.Text 
    End If 

    ' Set category as value for cells in Column A 
    Application.ActiveWorkbook.Worksheets("Sheet1").Cells(i - 1, 1).Value = category 

    ' Title begins outline level 1, and ends at the next outline level 1. 
    If outlineLevel = wdOutlineLevel2 Then ' e.g., 1.1 
     ' Get the title and update cells in Column B 
     title = para.Range.Text 
     Application.ActiveWorkbook.Worksheets("Sheet1").Cells(i, 2).Value = title 

     startPos = InStr(nextPosition, documentText, title, vbTextCompare) 

     If startPos <> stopPos Then 
      ' this is text between the two titles 
      body = Mid$(documentText, startPos, stopPos) 
      ActiveSheet.Cells(i - 1, 3).Value = body 
     End If 

     stopPos = startPos 
     i = i + 1 

    End If 


Next para 


WordDoc.Close 
WordApp.Quit 
Set WordDoc = Nothing 
Set WordApp = Nothing 
End Sub 

Link to Sample Doc

Answer 1

당신은 아마 지금 쯤 해결책을 찾았지만, 내가 무엇을 할 것이라고하는 것은 엑셀 열려 :

아래는 내가 가진 아주 초기 코드입니다 (I 디버깅하고 버그/수정이 있습니다) , 매크로 기록을 시작한 다음 셀을 선택하고 아이콘을 클릭하여 셀 입력 필드를 확장 한 다음 서식있는 텍스트를 붙여 넣습니다. 그런 다음 매크로를 중지하고 코드를 봅니다. 핵심은 상단의 셀 입력란에 붙여 넣는 것입니다. 단어 매크로에 필요한 약간의 코드를 가져옵니다. 희망이 도움이됩니다.