Excel파일 PDF 변환

'####################################################################################################################################################################################################################
'Excel2PDF: 2015.10.03, icarus.
'Version 1.0
'####################################################################################################################################################################################################################
'
'
'
'
'
'####################################################################################################################################################################################################################
'작업표시줄에 Userform 표시
'####################################################################################################################################################################################################################
'
Option Explicit

'API functions
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
                                       Alias "GetWindowLongA" _
                                       (ByVal hWnd As Long, _
                                        ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" _
                                       Alias "SetWindowLongA" _
                                       (ByVal hWnd As Long, _
                                        ByVal nIndex As Long, _
                                        ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32.dll" _
                                      (ByVal hWnd As Long, _
                                       ByVal hWndInsertAfter As Long, _
                                       ByVal X As Long, _
                                       ByVal Y As Long, _
                                       ByVal cx As Long, _
                                       ByVal cy As Long, _
                                       ByVal wFlags As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32.dll" _
                                    Alias "FindWindowA" _
                                    (ByVal lpClassName As String, _
                                     ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" _
                                         () As Long
Private Declare PtrSafe Function SendMessage Lib "user32.dll" _
                                     Alias "SendMessageA" _
                                     (ByVal hWnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32.dll" _
                                     (ByVal hWnd As Long) As Long




'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Private Sub UserForm_Activate()
    AddMinimiseButton   'Add a Minimize button to Userform
    AppTasklist Me    'Add this userform into the Task bar
End Sub

Private Sub AddMinimiseButton()
'//Add a Minimize button to Userform
    Dim hWnd As Long
    hWnd = GetActiveWindow
    Call SetWindowLong(hWnd, GWL_STYLE, _
                       GetWindowLong(hWnd, GWL_STYLE) Or _
                       WS_MINIMIZEBOX)
    Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
                      SWP_FRAMECHANGED Or _
                      SWP_NOMOVE Or _
                      SWP_NOSIZE)
End Sub

Private Sub AppTasklist(myForm)
'Add this userform into the Task bar
    Dim WStyle As Long
    Dim Result As Long
    Dim hWnd As Long

    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Visible = False
End Sub
'
'
'####################################################################################################################################################################################################################
'UserForm 사용
'####################################################################################################################################################################################################################
'Userform의 Excel2PDF 버튼 클릭시
Private Sub CommandButton1_Click()
  Dim fso, folder, files, NewsFile, sFolder, folderIdx, ws

  Set fso = CreateObject("Scripting.FileSystemObject")
  sFolder = GetFolder & "\" '탐색창에서 엑셀 파일이 있는 폴더 경로 선택 or 특정 경로 지정 ("D:\Excel2PDF\")
  Set folder = fso.GetFolder(sFolder)
  Set files = folder.files

  For Each folderIdx In files
    If (InStr(1, folderIdx.Name, ".xls", vbTextCompare)) Then
        Workbooks.Open Filename:=sFolder + folderIdx.Name
        Application.EnableEvents = False
        '특정한 시트만 선택해서 변환하고자 할 겨우 : "Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select"
        '숨겨진 시트를 제외하고 모든 시트 선택
        For Each ws In Sheets
            If ws.Visible Then ws.Select (False)
        Next
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFolder + Left(folderIdx.Name, Len(folderIdx.Name) - 4) + "pdf"
        ActiveWorkbook.Close savechanges:=False
    End If
'    If (InStr(1, folderIdx.Name, ".xlsx", vbTextCompare)) Then
'        Workbooks.Open Filename:=sFolder + folderIdx.Name
'        Application.EnableEvents = False
        '특정한 시트만 선택해서 변환하고자 할 겨우 : "Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select"
        '숨겨진 시트를 제외하고 모든 시트 선택
'        For Each ws In Sheets
'            If ws.Visible Then ws.Select (False)
'        Next
'        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFolder + Left(folderIdx.Name, Len(folderIdx.Name) - 5) + "pdf"
'        ActiveWorkbook.Close savechanges:=False
'    End If
  Next
  
  MsgBox "Excel 파일의 PDF 변환이 완료되었습니다."
End Sub

'탐색창에서 폴더 경로 선택
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function
'Userform의 Close 버튼 클릭시
Private Sub CommandButton2_Click()
' Close the "Excel2PDF" dialog box
    Unload UserForm1
    Application.Visible = True '숨길경우 = "Application.Visible = False"
'    ActiveWorkbook.Close savechanges:=False
End Sub
'Userform의 Print 버튼 클릭시
Private Sub CommandButton3_Click()
  Dim fso, folder, files, NewsFile, sFolder, folderIdx, ws

  Set fso = CreateObject("Scripting.FileSystemObject")
  sFolder = GetFolder & "\" '탐색창에서 엑셀 파일이 있는 폴더 경로 선택 or 특정 경로 지정 ("D:\Excel2PDF\")
  Set folder = fso.GetFolder(sFolder)
  Set files = folder.files

  For Each folderIdx In files
    If (InStr(1, folderIdx.Name, ".xls", vbTextCompare)) Then
        Workbooks.Open Filename:=sFolder + folderIdx.Name
        Application.EnableEvents = False
        '특정한 시트만 선택해서 변환하고자 할 겨우 : "Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select"
        '숨겨진 시트를 제외하고 모든 시트 선택
        For Each ws In Sheets
            If ws.Visible Then ws.Select (False)
        Next
        ActiveWindow.SelectedSheets.PrintOut
        ActiveWorkbook.Close savechanges:=False
    End If
'    If (InStr(1, folderIdx.Name, ".xlsx", vbTextCompare)) Then
'        Workbooks.Open Filename:=sFolder + folderIdx.Name
'        Application.EnableEvents = False
        '특정한 시트만 선택해서 변환하고자 할 겨우 : "Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select"
        '숨겨진 시트를 제외하고 모든 시트 선택
'        For Each ws In Sheets
'            If ws.Visible Then ws.Select (False)
'        Next
'        ActiveWindow.SelectedSheets.PrintOut
'        ActiveWorkbook.Close savechanges:=False
'    End If
  Next
  
  MsgBox "Excel 파일의 출력이 완료되었습니다."
End Sub