'MS word'에 해당되는 글 1건

  1. 2007.10.16 MS Word의 매크로(VBA) 를 이용한 텍스트 추출
Development2007.10.16 09:33

워드 파일에서 전체 텍스트의 내용을 특정 페이지 단위로 텍스트 파일에 저장해주는 매크로입니다.
워드 파일일 전체를 텍스트로 변환해 주는 프로그램은 많지만, 페이지 단위로 깔끔하게 나눠주는 프로그램이 없어서 W. Polmann(www.ecm-e.de) 이란 분이 작성한 doc_splitter() 매크로를 참조하여 작성해 봤습니다.
이 분의 코드가 독일어(?)로 되어있고, 워드에서 복사/붙여넣기를 통해 분할된 doc파일을 생성하다 보니 속도가 너무 느려서 FileSystemObject를 이용해서 바로 텍스트 파일에 저장되게 하였습니다.
이미지를 포함해 워드를 분할하실 분은 W. Polmann씨의 매크로와 좀 수정하시는게 빠를 것 같습니다.
필요하신 분이 과연 있을지는 모르겠지만 오랫만에 포스팅합니다. ^_^;

Sub Doc2Text_Splitter()
    Dim origDoc, splitFileName
    Dim Message, dlgTitle, dlgDefault
    Dim curPage, pageCount, pageSize
    Dim FSO, FileObject
   
    origDoc = ActiveDocument.Name
    Message = "몇 페이지씩 자를까?"
    dlgTitle = "Doc Splitter"
    dlgDefault = "2"
    pageSize = InputBox(Message, dlgTitle, dlgDefault)
    pageCount = ActiveDocument.ActiveWindow.Panes(1).Pages.Count
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    '// 문서의 처음으로 돌아감
    Selection.HomeKey Unit:=wdStory
   
    For curPage = 1 To pageCount Step pageSize
           
        '// 문서명_xxxx.txt 형식의 파일로 저장
        splitFileName = Left(origDoc, Len(origDoc) - 4) & "_" & Right("000" & curPage - 1, 4) & ".txt"
        '// 자르기를 시작할 페이지로 이동
        Selection.GoTo What:=wdGoToPage, Name:=curPage
        startPosition = Selection.Start
       
        '// 페이지의 마지막 위치로 이동해서 커서 위치를 확인
        Selection.GoTo What:=wdGoToPage, which:=wdGoToNext, Name:=(curPage + pageSize)
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        endPosition = Selection.End
        '// 복사할 위치값 체크
        If startPosition < endPosition Then
           
        '// 선택영역을 반전
            ActiveDocument.Range(startPosition, endPosition - 1).Select
           
        '// 파일을 생성하고 저장
            Set FileObject = FSO.CreateTextFile(ActiveDocument.Path & "\" & splitFileName, True, True)
            'FileObject.WriteLine (Selection.FormattedText.Text)
            FileObject.WriteLine (Selection.Text)
            FileObject.Close
            Set FileObject = Nothing
       
        End If
    Next curPage
   
    Set FSO = Nothing
End Sub
Posted by Blue*