Imports Microsoft.VisualBasic
Imports System.IO
Imports Microsoft.Office.Tools.Excel
Imports Microsoft.Office.Interop

'撰寫人員：吳宇澤
'撰寫日期：2012/09/21
'修改日期：2012/09/30
'版本號碼：v1.1
Public Class Form2
    Dim ofdOpen As New System.Windows.Forms.OpenFileDialog()

    '選取 Excel 檔
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        '事先設定: 預設路徑
        If String.IsNullOrEmpty(ofdOpen.InitialDirectory) Then
            ofdOpen.InitialDirectory = "C:" '預設開啟目錄
        End If

        ofdOpen.Filter = "Excel 檔 (*.xls; *.xlsx)|*.xls; *.xlsx|" & "All Files (*.*)|*.*"
        ofdOpen.Title = "請選擇 Excel 檔"
        ofdOpen.Multiselect = False

        '若在開啟對話框，按了「取消」(此處不可註解掉，不然選檔案的 Dialog 跑不出來)
        If (ofdOpen.ShowDialog(Me) = System.Windows.Forms.DialogResult.Cancel) Then
            '   MessageBox.Show("您取消了選取檔案！")
            Exit Sub
        End If

        Me.TextBox1.Text = ofdOpen.FileName

        Dim oExcel As New Excel.Application
        Dim oBooks As Excel.Workbooks
        Dim oBook As Excel.Workbook = Nothing
        Dim oSheets As Excel.Sheets
        Dim oSheet As Excel.Worksheet
        'Dim sTemplate As String

        'Excel 檔的「路徑 + 檔名」
        'sTemplate = ofdOpen.FileName

        oExcel.Visible = False
        oExcel.DisplayAlerts = False
        oBooks = oExcel.Workbooks

        Try
            oBooks.Open(ofdOpen.FileName)
            oBook = oBooks.Item(1)
            oSheets = oBook.Worksheets

            Me.CheckedListBox1.Items.Clear()    '移除所有的項目
            For Each oSheet In oSheets
                Me.CheckedListBox1.Items.Add(oSheet.Name)
            Next

            Me.Button2.Enabled = True
            Me.Button3.Enabled = True
            Me.btnCheckAll.Enabled = True
            Me.btnCancelAll.Enabled = True
        Catch ex As Exception
            Me.Button2.Enabled = False
            Me.Button3.Enabled = False
            Me.btnCheckAll.Enabled = False
            Me.btnCancelAll.Enabled = False
            MessageBox.Show("開啟檔案時發生錯誤！ 錯誤為：" & vbCrLf & ex.Message)
        Finally
            If Not oBook Is Nothing Then
                oBook.Close()
            End If
            If Not oBooks Is Nothing Then
                oBooks.Close()
            End If
            If Not oExcel Is Nothing Then
                oExcel.Quit()
            End If
        End Try
    End Sub

    Private Sub Form2_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Me.Button2.Enabled = False
        Me.Button3.Enabled = False
        Me.btnCheckAll.Enabled = False
        Me.btnCancelAll.Enabled = False
    End Sub

    '勾選的 sheet 轉成單一個 PDF 檔 (若選到空白的 sheet，不會出錯，但不會印出來)
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If CheckedListBox1.CheckedItems.Count <> 0 Then '若有勾選任一個 sheet
            Dim x As Integer
            Dim listChecked As New List(Of String)()    '有勾選的 sheet 中文名稱的集合
            For x = 0 To CheckedListBox1.CheckedItems.Count - 1
                listChecked.Add(CheckedListBox1.CheckedItems(x).ToString)
            Next x

            Dim listSheets As New List(Of String)()     '所有 sheet 中文名稱的集合
            For y As Integer = 0 To CheckedListBox1.Items.Count - 1
                listSheets.Add(CheckedListBox1.Items(y))
            Next

            'Dim s_x As String = ""
            'Dim s_y As String = ""

            'For Each s_x_2 In listSheets
            '    s_y &= s_x_2 & vbCrLf
            'Next
            'MessageBox.Show("所有sheets:" & vbCrLf & s_y)

            'For Each s_y_2 In listChecked
            '    s_x &= s_y_2 & vbCrLf
            'Next
            'MessageBox.Show("有勾的sheet:" & vbCrLf & s_x)

            Dim listUnChecked As List(Of String) = Nothing  '沒勾選的 sheet 中文名稱的集合

            '若未勾選所有的 sheet (至少有一個 sheet 被取消勾選)
            If listSheets.Count > listChecked.Count Then
                listUnChecked = New List(Of String)()

                For y As Integer = 0 To CheckedListBox1.Items.Count - 1
                    listUnChecked.Add(CheckedListBox1.Items(y))
                Next

                For Each s_x_3 In listSheets
                    If listChecked.Contains(s_x_3) Then
                        listUnChecked.Remove(s_x_3)
                    End If
                Next

                'Dim s_z As String = ""
                'For Each s_z_2 In listUnChecked
                '    s_z &= s_z_2 & vbCrLf
                'Next
                'MessageBox.Show("沒勾的sheet:" & vbCrLf & s_z)
            End If

            Me.ConvertCheckedSheetToOnePDF(TextBox1.Text.Trim(), listChecked, listUnChecked)
        Else '若未勾選任一個 sheet
            MessageBox.Show("轉換中止！" & vbCrLf & vbCrLf & "請先至少勾選一個 sheet。")
        End If
    End Sub

    '勾選的 sheet 轉成單一個 PDF 檔 (若選到空白的 sheet，不會出錯，但不會印出來)
    Public Sub ConvertCheckedSheetToOnePDF(ByVal PathAndFileName As String, ByVal listChecked As List(Of String), ByVal listUnChecked As List(Of String))
        Dim oExcel As New Excel.Application
        Dim oBooks As Excel.Workbooks, oBook As Excel.Workbook
        Dim oSheets As Excel.Sheets
        'Dim oSheet As Excel.Worksheet
        Dim sTemplate As String, sFileName As String

        'Excel 檔路徑
        sTemplate = PathAndFileName 'Server.MapPath("Demo1.xlsx")
        '捉路徑+檔名(不含副檔名)
        sFileName = PathAndFileName.Substring(0, PathAndFileName.LastIndexOf("."))

        oExcel.Visible = False
        oExcel.DisplayAlerts = False

        oBooks = oExcel.Workbooks
        oBooks.Open(sTemplate)
        oBook = oBooks.Item(1)
        oSheets = oBook.Worksheets

        'oSheet = CType(oSheets.Item(1), Excel.Worksheet)

        'oSheet = CType(oSheets.Item(2), Excel.Worksheet)
        'oSheet.ExportAsFixedFormat(Excel.XlFixedFormatType.xlTypePDF, "Demo2.pdf")

        'oSheet = CType(oSheets.Item(3), Excel.Worksheet)
        'oSheet.ExportAsFixedFormat(Excel.XlFixedFormatType.xlTypePDF, "Demo3.pdf")

        Button2.Enabled = False
        Button3.Enabled = False
        Dim dtStartTime As DateTime = DateTime.Now  '記錄轉換開始時的時間，以便後續統計整個轉換過程用了多少時間
        ProgressBar1.Visible = True '進度列
        ProgressBar1.Minimum = 1
        ProgressBar1.Maximum = listChecked.Count
        ProgressBar1.Value = 1
        ProgressBar1.Step = 1

        Try
            For i As Integer = 0 To listChecked.Count - 1
                ProgressBar1.PerformStep()  '進度列

                '另一種匯出方式(有缺陷):
                '將特定的幾個 sheet 移至 process 前面，再設定 PDF 要印出的頁數(如:1~5)。 但當有 sheet 超過一頁的高度時，後面的 sheet 會印不到
                'oBook.Sheets 前面的名稱必須正確對應到 Excel 裡的 sheet 名稱；
                'oBook.Sheets 後面的索引號碼不是指 sheet 的 index，而是一定要給它連號，如: 1,2,3,4...。且順序不能相反，如: 1,2,4,3,...。
                'oBook.Sheets(listChecked(i)).Move(Before:=oBook.Sheets(i + 1))
            Next
            'oBook.ExportAsFixedFormat(Type:=Excel.XlFixedFormatType.xlTypePDF, From:=1, To:=listChecked.Count, Filename:=sFileName & ".pdf", Quality:=Excel.XlFixedFormatQuality.xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False)

            'http://social.msdn.microsoft.com/forums/en-US/vsto/thread/85a3dac8-b32a-443a-8601-4e95935fe368
            'http://msdn.microsoft.com/en-us/library/microsoft.office.tools.excel.worksheet.copy(VS.80).aspx
            'oSheet2 = CType(oSheets2.Item("Sheet21"), Excel.Worksheet)  '等同Copy
            'System.Runtime.InteropServices.Marshal.BindToMoniker()

            'oBook2.Sheets.Add(oSheet2)  '新增工作表
            'oSheet2.Copy(After:=oSheets2("Sheet21"))

            'http://tgw1029.blogspot.com/2010/01/excel-vba-worksheet.html
            'Worksheets("sheet1").Copy Before:=Worksheets("sheet1")

            'Dim sss1 As String = ""
            'For Each wk As Excel.Worksheet In oBook.Sheets
            '    'MessageBox.Show(wk.Name)
            '    sss1 &= wk.Name & ","
            'Next

            '這種寫法，會引發: 無效的索引(發生例外狀況於 HRESULT: 0x8002000B (DISP_E_BADINDEX」
            'oBook.Sheets.Item(3).Delete()
            'oBook.Sheets("Sheet22").Delete()

            'Worksheet 操作大全:
            'http://topic.csdn.net/u/20080623/14/d47504a2-086b-4449-bffb-4f9ae6b62eb4.html
            'Dim sheetDelete As Excel.Worksheet = Nothing
            'sheetDelete = oBook.Sheets("Sheet21")
            'If Not sheetDelete Is Nothing Then
            '    sheetDelete.Delete()
            'End If

            'sheetDelete = Nothing

            'sheetDelete = oBook.Sheets("Sheet23")
            'If Not sheetDelete Is Nothing Then
            '    sheetDelete.Delete()
            'End If

            '將沒勾選的 Worksheet，從 Workbook 裡移除
            If Not listUnChecked Is Nothing Then
                If listUnChecked.Count > 0 Then
                    Dim sheetDelete As Excel.Worksheet = Nothing    '暫存用

                    For Each s_unC In listUnChecked
                        'oBook.Sheets(s_unC).Delete()   '這種寫法，會引發: 無效的索引(發生例外狀況於 HRESULT: 0x8002000B (DISP_E_BADINDEX」

                        sheetDelete = oBook.Sheets(s_unC)   '依 sheet 的中文名稱，作為移除的依據
                        If Not sheetDelete Is Nothing Then
                            sheetDelete.Delete()
                        End If

                        sheetDelete = Nothing
                    Next
                End If
            End If

            'Dim sss2 As String = ""
            'For Each wk2 As Excel.Worksheet In oBook.Sheets
            '    'MessageBox.Show(wk2.Name)
            '    sss2 &= wk2.Name & ","
            'Next

            oBook.ExportAsFixedFormat(Type:=Excel.XlFixedFormatType.xlTypePDF, Filename:=sFileName & ".pdf", Quality:=Excel.XlFixedFormatQuality.xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False)

            Dim timeInterval As New TimeSpan()
            timeInterval = DateTime.Now - dtStartTime
            MessageBox.Show("轉檔成功！ PDF 檔已經產生在原始檔案其所在目錄。" & _
                              vbCrLf & vbCrLf & "總共花了：" & _
                              timeInterval.Minutes & " 分 " & timeInterval.Seconds & " 秒 " & timeInterval.Milliseconds & " 毫秒")

            '********************************************************************
            '另一種匯出方式(有缺陷):
            '將特定的幾個 sheet 移至 process 前面，再設定 PDF 要印出的頁數(如:1~5)。 但當有 sheet 超過一頁的高度時，後面的 sheet 會印不到
            'http://social.msdn.microsoft.com/Forums/pl-PL/exceldev/thread/7b16b912-5356-4c3c-b517-6f1c91d26d72
            'http://www.cnblogs.com/mecity/archive/2011/06/23/2087973.html

            '前面的名稱必須正確對應到 Excel 裡的 sheet 名稱；
            '後面的索引號碼不是指 sheet 的 index，而是一定要給它連號，如: 1,2,3,4...。且順序不能相度，如: 1,2,4,3,...。
            'oBook.Sheets("Sheet1").Move(Before:=oBook.Sheets(1))
            'oBook.Sheets("工作表2").Move(Before:=oBook.Sheets(2))
            'oBook.Sheets("頁籤3").Move(Before:=oBook.Sheets(3))
            'oBook.Sheets("Sheet4").Move(Before:=oBook.Sheets(4))
            'oBook.Sheets("頁籤5").Move(Before:=oBook.Sheets(5))
            ''只匯出其中 n 個 sheet
            'oBook.ExportAsFixedFormat(Type:=Excel.XlFixedFormatType.xlTypePDF, From:=1, To:=5, Filename:=sFileName & ".pdf", Quality:=Excel.XlFixedFormatQuality.xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False)            

            '********************************************************************
            '其他匯出方式 :

            '(1) 只匯出預設的那一個 sheet
            'oBook.ActiveSheet.ExportAsFixedFormat(Type:=Excel.XlFixedFormatType.xlTypePDF, filename:="D:\pdf_test\Demo5.pdf", Quality:=Excel.XlFixedFormatQuality.xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True)

            '(2) 匯出第 1 ~ 第 2 個 sheet
            'oBook.ExportAsFixedFormat(Type:=Excel.XlFixedFormatType.xlTypePDF, From:=1, To:=2, Filename:="D:\pdf_test\Demo5.pdf", Quality:=Excel.XlFixedFormatQuality.xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False)

            '(3) 匯出所有的 sheet 至單一個 PDF
            'oBook.ExportAsFixedFormat(Type:=Excel.XlFixedFormatType.xlTypePDF, Filename:="D:\pdf_test\Demo3_有中文頁籤.pdf", Quality:=Excel.XlFixedFormatQuality.xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False)
            '********************************************************************
        Catch ex As Exception
            If ex.Message.IndexOf("0x800A03EC") <> -1 Then
                MessageBox.Show("您只勾選了內容為空白的 sheet，導致轉換時發生錯誤！" & vbCrLf & vbCrLf & _
                                "請加選任一個有內容的 sheet，再重新執行轉檔。")
            Else
                MessageBox.Show("轉換 Excel 檔時發生錯誤，錯誤為：" & vbCrLf & vbCrLf & ex.Message)
                'Throw New Exception("error ~ 不可有 sheet 為空" & ex.Message)
            End If
        Finally
            If Not oBook Is Nothing Then
                oBook.Close()
            End If
            If Not oBooks Is Nothing Then
                oBooks.Close()
            End If
            If Not oExcel Is Nothing Then
                oExcel.Quit()
            End If

            ProgressBar1.Visible = False
            Button2.Enabled = True
            Button3.Enabled = True
        End Try
    End Sub

    '勾選的 sheet 各轉成一個 PDF 檔 (若選到空白的 sheet，該 sheet 的轉換會失敗)
    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        If CheckedListBox1.CheckedItems.Count <> 0 Then
            Dim x As Integer
            Dim listChecked As New List(Of String)()
            For x = 0 To CheckedListBox1.CheckedItems.Count - 1
                listChecked.Add(CheckedListBox1.CheckedItems(x).ToString)
            Next x

            Me.ConvertCheckedSheetToMultiplePDF(TextBox1.Text.Trim(), listChecked)
        Else
            MessageBox.Show("轉換中止！" & vbCrLf & vbCrLf & "請先至少勾選一個 sheet。")
        End If
    End Sub

    '勾選的 sheet 各轉成一個 PDF 檔 (若選到空白的 sheet，該 sheet 的轉換會失敗)
    Public Sub ConvertCheckedSheetToMultiplePDF(ByVal PathAndFileName As String, ByVal listChecked As List(Of String))
        Dim oExcel As New Excel.Application
        Dim oBooks As Excel.Workbooks, oBook As Excel.Workbook
        Dim oSheets As Excel.Sheets
        Dim oSheet As Excel.Worksheet
        Dim sTemplate As String, sFileName As String

        ' Excel 檔路徑
        sTemplate = PathAndFileName 'Server.MapPath("Demo1.xlsx")
        '捉路徑+檔名(不含副檔名)
        sFileName = PathAndFileName.Substring(0, PathAndFileName.LastIndexOf("."))

        oExcel.Visible = False
        oExcel.DisplayAlerts = False

        oBooks = oExcel.Workbooks
        oBooks.Open(sTemplate)
        oBook = oBooks.Item(1)
        oSheets = oBook.Worksheets

        Button2.Enabled = False
        Button3.Enabled = False
        Dim dtStartTime As DateTime = DateTime.Now  '記錄轉換開始時的時間，以便後續統計整個轉換過程用了多少時間'進度列
        ProgressBar1.Visible = True
        ProgressBar1.Minimum = 1
        ProgressBar1.Maximum = listChecked.Count
        ProgressBar1.Value = 1
        ProgressBar1.Step = 1

        Try
            'Dim ss As String = ""
            'oSheet = CType(oSheets.Item(listChecked(0)), Excel.Worksheet)
            'MessageBox.Show(oSheet.Name)

            For i As Integer = 0 To listChecked.Count - 1
                ProgressBar1.PerformStep()  '進度列

                'ss &= listChecked(i) & vbCrLf
                oSheet = CType(oSheets.Item(listChecked(i)), Excel.Worksheet)
                'ss &= oSheet.Name & vbCrLf
                oSheet.ExportAsFixedFormat(Excel.XlFixedFormatType.xlTypePDF, IncludeDocProperties:=True, OpenAfterPublish:=False, Quality:=Excel.XlFixedFormatQuality.xlQualityStandard, _
                                          Filename:=sFileName & "_" & oSheet.Name & ".pdf")
            Next
            'MessageBox.Show(ss)

            Dim timeInterval As New TimeSpan()
            timeInterval = DateTime.Now - dtStartTime
            MessageBox.Show("轉檔成功！ PDF 檔已經產生在原始檔案其所在目錄。" & _
                              vbCrLf & vbCrLf & "總共花了：" & _
                              timeInterval.Minutes & " 分 " & timeInterval.Seconds & " 秒 " & timeInterval.Milliseconds & " 毫秒")
        Catch ex As Exception
            If ex.Message.IndexOf("0x800A03EC") <> -1 Then
                'Throw New Exception("error ~ 不可有 sheet 為空" & ex.Message)
                MessageBox.Show("Excel 中有些 sheet 內容為空白，導致該 sheet 轉換失敗！" & vbCrLf & vbCrLf & _
                                "請取消勾選內容為空白的 sheet，再重新執行轉檔。")
            Else
                MessageBox.Show("轉換 Excel 檔時發生錯誤，錯誤為：" & vbCrLf & vbCrLf & ex.Message)
            End If
        Finally
            If Not oBook Is Nothing Then
                oBook.Close()
            End If
            If Not oBooks Is Nothing Then
                oBooks.Close()
            End If
            If Not oExcel Is Nothing Then
                oExcel.Quit()
            End If

            ProgressBar1.Visible = False
            Button2.Enabled = True
            Button3.Enabled = True
        End Try
    End Sub

    '全部勾選
    Private Sub btnCheckAll_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCheckAll.Click
        For i As Integer = 0 To (CheckedListBox1.Items.Count - 1)
            CheckedListBox1.SetItemChecked(i, True)
        Next
    End Sub

    '全部取消勾選
    Private Sub btnCancelAll_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCancelAll.Click
        For i As Integer = 0 To (CheckedListBox1.Items.Count - 1)
            CheckedListBox1.SetItemChecked(i, False)
        Next
    End Sub

End Class