ppt를 jpg로 저장할 때 사이즈

아래 첨부한 VBA 매크로파일을 이용해보시기 바랍니다.

실행방법은 첨부파일을 매크로 허용해서 열어두시고 질문자님의 파일을 연 다음 Alt-F8이나 개발도구->매크로 를 눌러서 매크로창이 뜨면 먼저 매크로 위치를 첨부파일(SaveASImage2.pptm)로 한 다음 아래 두 가지 매크로를 실행하면 됩니다. ​ 1번은 반드시 그림과 텍스트 상자를 동시에 선택하고 실행하고 2번은 원하는 슬라이드들을 선택 한 후에 매크로를 실행하세요.

​

1. SaveShapesAsImage: 현재 선택된 도형(그림과 텍스트 상자 등)을 주어진 px 크기대로 하나의 그림으로 저장.

여러개의 도형일 경우 그룹으로 만든 후에 저장함. (그룹으로 묶이지 않는 표 등은 에러 발생)

Option Explicit Public Const Ext As String = "png" Const ExtType As Integer = ppShapeFormatPNG 'Public Const Ext As String = "jpg" '"emf" 'Const ExtType As Integer = ppShapeFormatJPG Public Const JPEGHigh As Boolean = False Public Const JPEGRate As Single = 95 'JPG화질(압축률) Sub SaveShapesAsImage() Dim shpRng As ShapeRange Dim shp As Shape, shpEMF As Shape, sld As Slide Dim oldWidth As Single Dim usr As String, strFile As String, strEMF As String On Error Resume Next Set shpRng = ActiveWindow.Selection.ShapeRange On Error GoTo 0 If shpRng Is Nothing Then MsgBox "먼저 저장할 개체(도형)을 선택하세요.", _ vbInformation, "이미지로 저장": Exit Sub usr = InputBox("저장할 이미지의 긴쪽 크기를 px단위로 입력하세요", "그림으로 저장", 1024) If Not IsNumeric(usr) Then Exit Sub If shpRng.Count > 1 Then Set shp = shpRng.Group shp.Name = "temp_Group_" & shp.Id Else Set shp = shpRng(1) End If Set sld = shp.Parent '// 현재 선택된 개체를 그룹으로 만들고 긴쪽 길이를 원하는 px 크기의 이미지로 저장 With shp strFile = getPath(shpRng(1).Name & shpRng(1).Id) ' 대화창으로 저장파일명 얻기 If Len(strFile) < 1 Then Exit Sub 'oldWidth = .Width '원래 가로 크기 저장 '.Line.Visible = msoFalse '임시로 EMF로 저장 후 다시 삽입 strEMF = strFile & ".emf" .Export strEMF, ppShapeFormatEMF DoEvents '.Width = oldWidth '원래 가로크기로 복구 If .Type = msoGroup Then .Ungroup End With Set shpEMF = sld.Shapes.AddPicture(strEMF, msoFalse, msoTrue, 0, 0) DoEvents Kill strEMF With shpEMF .LockAspectRatio = msoTrue If .Width > .Height Then .Width = CInt(usr) * 0.75 '// 1px = 0.75pt Else .Height = CInt(usr) * 0.75 '// 1px = 0.75pt End If .Export strFile, ExtType DoEvents .Delete End With If JPEGHigh Then '압축률을 지정해서 변환 저장 / 기본 85 Call WIA_ConvertImage(strFile, Left(strFile, InStrRev(strFile, ".")) & "jpg", JPEG, JPEGRate) Kill strFile 'png 삭제 End If End Sub Function getPath(title As String) As String Dim i As Integer With Application.FileDialog(msoFileDialogSaveAs) .title = title & " 파일로 저장" .AllowMultiSelect = False .InitialFileName = ActivePresentation.Path & "\" & title & "." & Ext '.FilterIndex = 20 For i = 1 To .Filters.Count If .Filters(i).Extensions = "*." & Ext Then .FilterIndex = i: Exit For Next i If .Show = -1 Then getPath = .SelectedItems(1) End With End Function

- 텍스트 상자가 포함된 경우 확대해도 텍스트는 그대로이고 도형만 커지기 때문에 일단 임시로 EMF로 저장했다가 EMF를 다시 삽입한 다음 크기를 변경하고 다시 png나 jpg 로 저장하도록 했습니다.

- 선택된 도형에 텍스트 상자가 포함된 경우 텍스트상자가 전체 테두리에 너무 가까운 경우 저장 이미지의 크기가 더 커질 수도 있습니다.

​

​

2. SaveSlidesAsImages : 현재 다중 선택된 슬라이드들을 대상으로 슬라이드 통채로 주어진 px크기대로 각각 이미지로 저장

Option Explicit Option Compare Text 'Private Const Ext As String = "png" Sub SaveSl____________() End Sub Sub SaveSlidesAsImages() Dim sld As Slide Dim fname As String, usize As String Dim size As Single, w As Single, h As Single Dim i As Integer size = 3072 '2010버전의 경우 최대 3072px '2019의 경우 9216px도 가능 If Application.Version >= 15 Then size = 9216 With ActivePresentation If Not .Saved Then MsgBox "파일을 먼저 저장해야합니다.", vbInformation: Exit Sub usize = InputBox("저장할 이미지의 긴 쪽의 크기를 픽셀단위로 입력하세요.", "현재 슬라이드 이미지 저장", size) If Not IsNumeric(usize) Then MsgBox "숫자로 입력하세요", vbInformation: Exit Sub size = CSng(usize) If .PageSetup.SlideOrientation = msoOrientationHorizontal Then w = size h = w * (.PageSetup.SlideHeight / .PageSetup.SlideWidth) ' 비율유지한 상태로 최대 크기 Else h = size w = h * (.PageSetup.SlideWidth / .PageSetup.SlideHeight) End If 'Debug.Print w, h For Each sld In ActiveWindow.Selection.SlideRange fname = .Path & "\" & Left(.Name, InStrRev(.Name, ".") - 1) & "_" & Format(sld.SlideIndex, "000") & "." & Ext If Ext = "emf" Or Ext = "wmf" Then sld.Export fname, Ext Else sld.Export fname, Ext, w, h End If If JPEGHigh Then '압축률 95 jpg로 변환 저장 / 기본 85 Call WIA_ConvertImage(fname, Left(fname, InStrRev(fname, ".")) & "jpg", JPEG, JPEGRate) Kill fname 'png 삭제 End If i = i + 1 Next sld MsgBox i & "개의 슬라이드 이미지 저장 완료" End With End Sub

​

현재는 PNG 형식인데 JPG를 원하시면 Ext = "jpg"로 바꾸면 됩니다.

그런데 이렇게 .export 에서 jpg로 바로 저장하면 압축률을 지정할 수 없습니다.

​

jpg형식으로 저장하되 높은 화질의 압축률로 저장하려면 그보다는 Ext = "png"로 그대로 두고 JPGHigh = True 로 바꿔주세요. 이렇게 하면 일단 png로 저장한 후에 윈도우의 WIA 외부 라이브러리를 이용하여 압축률을 지정해서 다시 jpg로 변환하여 저장합니다.

Public Enum wiaFormat BMP = 0 GIF = 1 JPEG = 2 PNG = 3 TIFF = 4 End Enum '--------------------------------------------------------------------------------------- ' Procedure : WIA_ConvertImage ' Author : Daniel Pineault, CARDA Consultants Inc. ' Website : http://www.cardaconsultants.com ' Purpose : Convert an image's format using WIA ' Copyright : The following is release as Attribution-ShareAlike 4.0 International ' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/ ' Req'd Refs: Uses Late Binding, so none required ' ' Windows Image Acquisition (WIA) ' https://msdn.microsoft.com/en-us/library/windows/desktop/ms630368(v=vs.85).aspx ' ' Input Variables: ' ~~~~~~~~~~~~~~~~ ' sInitialImage : Fully qualified path and filename of the original image to resize ' sOutputImage : Fully qualified path and filename of where to save the new image ' lFormat : Format to convert the image into ' lQuality : Quality level to be used for the conversion process (1-100) ' ' Usage: ' ~~~~~~ ' Call WIA_ConvertImage("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg", _ ' "C:\Users\MyUser\Desktop\Chrysanthemum_2.jpg", _ ' JPEG) ' ' Revision History: ' Rev Date(yyyy/mm/dd) Description ' ************************************************************************************** ' 1 2017-01-18 Initial Release ' 2 2018-09-20 Updated Copyright '--------------------------------------------------------------------------------------- Public Function WIA_ConvertImage(sInitialImage As String, _ sOutputImage As String, _ lFormat As wiaFormat, _ Optional lQuality As Long = 85) As Boolean On Error GoTo Error_Handler Dim oWIA As Object 'WIA.ImageFile Dim oIP As Object 'ImageProcess Dim sFormatID As String Dim sExt As String 'Convert our Enum over to the proper value used by WIA Select Case lFormat Case 0 sFormatID = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}" sExt = "BMP" Case 1 sFormatID = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}" sExt = "GIF" Case 2 sFormatID = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}" sExt = "JPG" 'sExt = "JPEG" Case 3 sFormatID = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}" sExt = "PNG" Case 4 sFormatID = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}" sExt = "TIFF" End Select If lQuality > 100 Then lQuality = 100 'Should check if the output file already exists and if so, 'prompt the user to overwrite it or not Set oWIA = CreateObject("WIA.ImageFile") Set oIP = CreateObject("WIA.ImageProcess") oIP.Filters.Add oIP.FilterInfos("Convert").FilterID oIP.Filters(1).Properties("FormatID") = sFormatID oIP.Filters(1).Properties("Quality") = lQuality oWIA.LoadFile sInitialImage Set oWIA = oIP.Apply(oWIA) 'Overide the specified ext with the appropriate one for the choosen format oWIA.SaveFile Left(sOutputImage, InStrRev(sOutputImage, ".")) & LCase(sExt) WIA_ConvertImage = True Error_Handler_Exit: On Error Resume Next If Not oIP Is Nothing Then Set oIP = Nothing If Not oWIA Is Nothing Then Set oWIA = Nothing Exit Function Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: WIA_ConvertImage" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Function

자주 사용한다면 위 기능을 추가기능으로 변환해서 리본메뉴에 추가할 수도 있습니다. 원하시는 경우 재질문바랍니다.