워드 파일 이미지 파일로 변환 방법- 빠른 실행도구

온라인에 올려도되는 자료면, 아래에서 해보셔도 좋을듯합니다.^^
https://convertio.co/kr/doc-jpg/
https://www.freeconvert.com/ko/doc-to-jpg
https://www.freeconvert.com/ko/word-to-jpg

안녕하세요~

MS 워드 문서를 이미지(JPG/PNG)로 변환할 때는
PowerPoint를 중간에 활용하는 방식이 가장 안정적입니다.

왜냐하면,

Word는 “페이지를 바로 이미지로 저장”하는 기능이 없고,
PDF 경유 방식은 해상도 제어가 어렵고 여백이 깨질 수 있습니다.

반면에,
PowerPoint는 슬라이드 자체를 고정 해상도로 곧바로 JPG/PNG 내보낼 수 있어 품질 유지가 가능합니다.

그래서 Word의 각 페이지를 PowerPoint 슬라이드로 옮긴 후
슬라이드를 JPG로 Export하는 VBA 코딩이 가장 많이 쓰입니다.

아래 코딩을 참고하시고, 첨부파일을 테스트해 보세요~

이곳은 엑셀파일만 업로드가 가능하므로 docm을 zip을 압축해서 올렸으니 압축을 풀고 사용하시고,
이 사이트의 정책에 위반이라면 삭제하도록 하겠습니다.

Option Explicit

'== 상수 정의 ==
Private Const A4_WIDTH_PT As Double = 595.2755906
Private Const A4_HEIGHT_PT As Double = 841.8897638
Private Const PP_LAYOUT_BLANK As Long = 12
Private Const PP_PASTE_EMF As Long = 2
Private Const DEFAULT_DPI As Long = 200
Private Const SAFETY_PADDING As Double = 1#

Public Sub WordToJPG()
    On Error GoTo EH
    
    Dim Doc As Document
    Dim pTot As Long, i As Long
    Dim fNm As String, fDir As String
    Dim dpi As Long, dpiR As Double
    
    Dim ppApp As Object, ppPrs As Object
    Dim ppSld As Object
    Dim tSt As Double, tEl As Double
    Dim Rng As Range
    Dim sCnt As Long
    
    Application.ScreenUpdating = False
    tSt = Timer
    
    '// 1. 문서 초기화 ==
    Set Doc = ActiveDocument
    Options.Pagination = True
    Doc.Repaginate
    pTot = Doc.ComputeStatistics(wdStatisticPages)
    If pTot = 0 Then
        MsgBox "페이지가 감지되지 않습니다.", vbExclamation
        GoTo CleanExit
    End If
    
    '// 2. 사용자 입력 : 저장폴더, 이미지이름, 해상도 ==
    If Not GetUserInputs(Doc, fDir, fNm, dpi) Then GoTo CleanExit
    dpiR = dpi / 72#
    
    '// 3. PowerPoint 초기화 ==
    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
    ppApp.WindowState = 2                 ' 최소화
    Set ppPrs = ppApp.Presentations.Add
    
    '// 3-1. 슬라이드 하나만 생성 (재사용)
    Set ppSld = ppPrs.Slides.Add(1, PP_LAYOUT_BLANK)
    
    '// 4. 페이지 루프
    For i = 1 To pTot
        On Error Resume Next
        
        Application.StatusBar = "이미지 변환 중... " & i & "/" & pTot & _
                                " (" & Format$(i / pTot, "0%") & ")"
        
        Set Rng = GetPageRange(Doc, i, pTot)
        ClearSlide ppSld
        
        If ProcessPage(Rng, ppPrs, ppSld, dpiR, fDir, fNm, i) Then
            sCnt = sCnt + 1
        End If
        
        On Error GoTo EH
    Next i
    
    '// 5. 완료 메시지
    tEl = Timer - tSt
    MsgBox "완료!" & vbCrLf & vbCrLf & _
           "성공: " & sCnt & " / " & pTot & " 페이지" & vbCrLf & _
           "위치: " & fDir & vbCrLf & _
           "소요시간: " & Format$(tEl, "0.0") & "초", vbInformation

CleanExit:
    Application.StatusBar = False
    On Error Resume Next
    If Not ppPrs Is Nothing Then ppPrs.Close
    If Not ppApp Is Nothing Then ppApp.Quit
    Application.ScreenUpdating = True
    Exit Sub

EH:
    MsgBox "오류: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Export JPG"
    Resume CleanExit
End Sub

'// 2-1 페이지 범위 가져오기 ==
Private Function GetPageRange(ByVal Doc As Document, ByVal pNo As Long, ByVal pTot As Long) As Range
    Dim rSt As Long, rEd As Long
    rSt = Doc.GoTo(wdGoToPage, wdGoToAbsolute, pNo).Start
    If pNo < pTot Then
        rEd = Doc.GoTo(wdGoToPage, wdGoToAbsolute, pNo + 1).Start - 1
    Else
        rEd = Doc.Content.End
    End If
    Set GetPageRange = Doc.Range(rSt, rEd)
End Function

'// 4-1 슬라이드 초기화 ==
Private Sub ClearSlide(ByVal Sld As Object)
    Dim Shp As Object
    For Each Shp In Sld.Shapes
        Shp.Delete
    Next
End Sub

'// 4-3 페이지 처리 ==
Private Function ProcessPage(ByVal Rng As Range, ByVal ppPrs As Object, ByVal ppSld As Object, _
                             ByVal dpiR As Double, ByVal fDir As String, _
                             ByVal fNm As String, ByVal pNo As Long) As Boolean
    On Error GoTo EH
    
    Dim pW As Single, pH As Single
    Dim Shp As Object
    Dim isPrt As Boolean
    Dim pxW As Long, pxH As Long
    Dim sFile As String
    
    '// 방향 판단 및 A4 크기 설정
    isPrt = (Rng.Sections(1).PageSetup.PageHeight >= Rng.Sections(1).PageSetup.PageWidth)
    If isPrt Then
        pW = A4_WIDTH_PT: pH = A4_HEIGHT_PT
    Else
        pW = A4_HEIGHT_PT: pH = A4_WIDTH_PT
    End If
    
    '// 슬라이드 크기 설정
    With ppPrs.PageSetup
        .SlideWidth = pW
        .SlideHeight = pH
    End With
    
    '// 페이지 복사 및 붙여넣기
    Rng.Copy
    Set Shp = ppSld.Shapes.PasteSpecial(DataType:=PP_PASTE_EMF)(1)
    
    '// 여백 반영 및 위치 조정
    PositionShapeWithMargins Shp, Rng, pW, pH
    
    '// JPG 저장
    pxW = CLng(pW * dpiR)
    pxH = CLng(pH * dpiR)
    sFile = fDir & fNm & "_" & Format$(pNo, "000") & ".jpg"
    ppSld.Export sFile, "JPG", pxW, pxH
    
    ProcessPage = True
    Exit Function
EH:
    ProcessPage = False
End Function

'// 4-4 여백 반영 위치 조정
Private Sub PositionShapeWithMargins(ByVal Shp As Object, ByVal Rng As Range, _
                                     ByVal pW As Single, ByVal pH As Single)
    Dim mL As Double, mR As Double, mT As Double, mB As Double
    Dim bW As Double, bH As Double
    Dim k As Double
    
    With Rng.Sections(1).PageSetup
        mL = .LeftMargin
        mR = .RightMargin
        mT = .TopMargin
        mB = .BottomMargin
    End With
    
    '// 콘텐츠 박스 크기 계산
    bW = pW - mL - mR - 2 * SAFETY_PADDING: If bW < 0 Then bW = 0
    bH = pH - mT - mB - 2 * SAFETY_PADDING: If bH < 0 Then bH = 0
    
    '// 비율 유지 축소
    If (bW / Shp.Width) < (bH / Shp.Height) Then
        k = bW / Shp.Width
    Else
        k = bH / Shp.Height
    End If
    
    Shp.LockAspectRatio = -1
    Shp.Width = Shp.Width * k
    Shp.Height = Shp.Height * k
    
    '// 여백 + 중앙 정렬
    Shp.Left = mL + SAFETY_PADDING + (bW - Shp.Width) / 2
    Shp.Top = mT + SAFETY_PADDING + (bH - Shp.Height) / 2
End Sub

'// 2-2. 사용자 입력 받기 ==
Private Function GetUserInputs(ByVal Doc As Document, ByRef fDir As String, _
                               ByRef fNm As String, ByRef dpi As Long) As Boolean
    '// 폴더 선택
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "JPG를 저장할 폴더를 선택하세요"
        If .Show <> -1 Then Exit Function
        fDir = .SelectedItems(1)
    End With
    If Right$(fDir, 1) <> "\" Then fDir = fDir & "\"
    
    '// 파일 기본이름
    fNm = InputBox("파일 기본 이름을 입력하세요" & vbCrLf & _
                   "(예: " & RemoveExt(Doc.Name) & ")", _
                   "기본 이름", RemoveExt(Doc.Name))
    If Len(Trim$(fNm)) = 0 Then Exit Function
    
    '// DPI 설정
    dpi = CLng(Val(InputBox("저장 해상도(DPI)를 입력하세요." & vbCrLf & _
                            "일반: 150, 선명: 200~300 (기본 " & DEFAULT_DPI & ")", _
                            "해상도(DPI)", CStr(DEFAULT_DPI))))
    If dpi <= 0 Then dpi = DEFAULT_DPI
    
    GetUserInputs = True
End Function

'// 확장자 제거
Private Function RemoveExt(ByVal nm As String) As String
    Dim p As Long
    p = InStrRev(nm, ".")
    If p > 0 Then RemoveExt = Left$(nm, p - 1) Else RemoveExt = nm
End Function

​

답변 감사합니다.
AI한테 물었더니 말씀하신대로 PPT로 변환후 다시 이미지 파일로 변환하는 과정을 코드로 작성하더군요.
혹시나 다른 방법이 있지 않을까 해서....
현재 제가 사용하는 방법은 파일을 pdf로 변환한 다음 ez*** 프로그램을 사용해서 다시 이미지 파일로 바꾸는 방법을 사용하고 있습니다.
MS에서 왜 WORD에 이미지 파일로 저장하는 내용을 넣지 않은지 궁금하네요..  

굉장히 복잡하고 어려운 문제네요..

자세한 답변 감사합니다.

어쩔 수 없이 외부 프로그램을 이용해야겠네요