Sub Xls2Pdf()
Dim a As Application: Set a = Application
On Error Resume Next
a.PrintCommunication = False : 프린트 설정을 해야하는데 False가 되면 안될 것 같네요.
a.DisplayAlerts = False: a.ScreenUpdating = False
Dim fso, folder, files, NewsFile, sFolder, ws As Worksheet
상기 문장은 실행에는 지장이 없지만 Dim 문장은 가능한 분리해야 좋습니다.
위에 문장처럼 사용하면 마지막 ws as Worksheet만 형식 선언이 됩니다.
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\Users\ppp\Desktop\새홀리기\"
Set folder = fso.GetFolder(sFolder)
이 문장은 sub 폴더를 찾아서 각 subfolder를 반복하려는 의도인데, 각 반복문이 없네요. sFolder 파일만 실행될 겁니다.
Set files = folder.files
For Each folderIdx In files
If InStr(1, Right(folderIdx.Name, 5), ".xls", vbTextCompare) Then
Workbooks.Open Filename:=sFolder + folderIdx.Name
For Each ws In ActiveWorkbook.Sheets
ws.PageSetup.Zoom = False
ws.PageSetup.Orientation=xlLandScape '예시를 보니 가로로 하려는 것 같은데 이 문장이 필요합니다.
ws.PageSetup.FitToPagesWide = 1
ws.PageSetup.FitToPagesTall = 0 100 ' 뭔가 변화가 없으면 배율의 변화를 인지를 못하는 경우가 있습니다.
'충분히 큰 수를 입력해 두면 알아서 가로/세로 중에 작은 수(여기서는 가로 폭)가 우선됩니다.
Next
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sFolder + Left(folderIdx.Name, Len(folderIdx.Name) - 4) + ".pdf"
'작업 중인 폴더에 새 파일이 들어오면 For Each 문에서 오작동 할 우려도 있으니 별도 폴더로 지정하는 게 좋을 것 같네요.
' 아래 문장에서 변경무시하고 저장했지만, Test 중에 Save를 했더니 무한 루프에 빠집니다.
ActiveWorkbook.Close SaveChanges:=False
End If
Next: a.PrintCommunication = True: Set a = Nothing
End Sub