Imports Microsoft.Office.Interop
Imports Microsoft.Win32

Public Class Form1
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()
        GetExcelVer()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    Friend WithEvents cmdStartExcel As System.Windows.Forms.Button
    Friend WithEvents cmdQuitExcel As System.Windows.Forms.Button
    Friend WithEvents cmdCauseError As System.Windows.Forms.Button
    Friend WithEvents cmdChangeCells As System.Windows.Forms.Button
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.cmdStartExcel = New System.Windows.Forms.Button
        Me.cmdQuitExcel = New System.Windows.Forms.Button
        Me.cmdCauseError = New System.Windows.Forms.Button
        Me.cmdChangeCells = New System.Windows.Forms.Button
        Me.SuspendLayout()
        '
        'cmdStartExcel
        '
        Me.cmdStartExcel.Location = New System.Drawing.Point(16, 40)
        Me.cmdStartExcel.Name = "cmdStartExcel"
        Me.cmdStartExcel.Size = New System.Drawing.Size(104, 23)
        Me.cmdStartExcel.TabIndex = 0
        Me.cmdStartExcel.Text = "Uruchom Excela"
        '
        'cmdQuitExcel
        '
        Me.cmdQuitExcel.Location = New System.Drawing.Point(16, 152)
        Me.cmdQuitExcel.Name = "cmdQuitExcel"
        Me.cmdQuitExcel.Size = New System.Drawing.Size(104, 24)
        Me.cmdQuitExcel.TabIndex = 1
        Me.cmdQuitExcel.Text = "Zakończ Excela"
        '
        'cmdCauseError
        '
        Me.cmdCauseError.Location = New System.Drawing.Point(16, 72)
        Me.cmdCauseError.Name = "cmdCauseError"
        Me.cmdCauseError.Size = New System.Drawing.Size(104, 32)
        Me.cmdCauseError.TabIndex = 2
        Me.cmdCauseError.Text = "Spowoduj błąd"
        '
        'cmdChangeCells
        '
        Me.cmdChangeCells.Location = New System.Drawing.Point(16, 112)
        Me.cmdChangeCells.Name = "cmdChangeCells"
        Me.cmdChangeCells.Size = New System.Drawing.Size(104, 32)
        Me.cmdChangeCells.TabIndex = 3
        Me.cmdChangeCells.Text = "Modyfikuj komórki"
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(292, 273)
        Me.Controls.Add(Me.cmdChangeCells)
        Me.Controls.Add(Me.cmdCauseError)
        Me.Controls.Add(Me.cmdQuitExcel)
        Me.Controls.Add(Me.cmdStartExcel)
        Me.Name = "Form1"
        Me.Text = "Formularz1"
        Me.ResumeLayout(False)

    End Sub

#End Region

    ' .NET Windows form code
    Dim WithEvents m_xl As Excel.Application
    Dim WithEvents m_ws As Excel.Worksheet

    Private Sub cmdStartExcel_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles cmdStartExcel.Click
        ' Utworzenie nowego egzemplarza obiektu, jeśli go nie zainicjowano.
        If IsNothing(m_xl) Then _
            m_xl = New Excel.Application
        ' Wyświetlenie Excela.
        m_xl.Visible = True
        Dim wb As Excel.Workbook, rng As Excel.Range
        ' Utworzenie nowego skoroszytu.
        wb = m_xl.Workbooks.Add()
        ' Wprowadzenie przykładowych danych
        For i As Integer = 1 To 10
            rng = wb.Worksheets(1).Cells(1, i)
            rng.Value = 2 ^ i
        Next
        ' Powiązanie arkusza ze zdarzeniami z wykorzystaniem zmiennej poziomu klasy.
        m_ws = wb.Worksheets(1)
    End Sub

    Private Sub cmdQuitExcel_Click(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles cmdQuitExcel.Click
        ' Zamknięcie aplikacji Excela.
        m_xl.Quit()
        ' Ustawienie adresu obiektu na Nothing.
        Debug.Write(IsNothing(m_xl))
        m_xl = Nothing
        ' Wymuszone odśmiecanie.
        System.GC.Collect()
    End Sub

    Private Sub m_ws_Change(ByVal Target As Microsoft.Office.Interop.Excel.Range) _
      Handles m_ws.Change
        If Target.Address = "$A$2" Then
            Dim NetStr As New NetForExcel.NetString
            m_ws.Range("B2").Value = NetStr.Sort(Target.Value)
        End If
    End Sub

    Private Sub cmdCauseErrors_Click(ByVal sender As System.Object, _
      ByVal e As System.EventArgs) Handles cmdCauseError.Click
        ' Spowodowanie ogólnego błędu Excela. 
        Try
            ' Tena arkusz (9) nie istnieje.
            m_xl.ActiveWorkbook.Sheets(9).Range("B2").value = 42
        Catch ex As System.Runtime.InteropServices.COMException
            Debug.WriteLine(ex.Source & " " & ex.Message & " " & Hex(ex.errorcode) _
              & " " & GetErrCode(ex.ErrorCode))
        End Try
        ' Spowodowanie błędu aplikacji w Excelu.
        Try
            ' To jest nieprawidłowa wartość w komórce.
            m_ws.Range("A3").Value = "=To nie działa."
        Catch ex As System.Runtime.InteropServices.COMException
            Debug.WriteLine(ex.Source & " " & ex.Message & " " & Hex(ex.errorcode) _
              & " " & GetErrCode(ex.ErrorCode))
        End Try
        ' Spowodowanie ogólnego błędu Excela (nie zawiera kodu HRESULT!)
        Try
            m_xl.Workbooks.Open("nieistnieje.xls")
        Catch ex As System.Runtime.InteropServices.COMException
            Debug.WriteLine(ex.Source & " " & ex.Message & " " & Hex(ex.errorcode) _
             & " " & GetErrCode(ex.ErrorCode))
        End Try
        ' Spowodowanie błędu Interop.
        Try
            ' Aby zobaczyć błąd ustaw tu pułapkę (breakpoint) i wyedytuj komórkę w Excelu.
            m_xl.ActiveWorkbook.Sheets(1).Range("B3").select()
            ' Nie można zmodyfikować komórki w czasie, gdy jest w trybie edycji w Excelu.
            m_xl.ActiveWorkbook.Sheets(1).Range("B2").value = 42
        Catch ex As System.Runtime.InteropServices.COMException
            Debug.WriteLine(ex.Source & " " & ex.Message & " " & Hex(ex.errorcode) _
              & " " & GetErrCode(ex.ErrorCode))
        End Try
    End Sub

    ' Interpretuje kod HRESULT.
    Function GetFacility(ByVal hresult As Integer) As String
        ' Pierwszy bit kodu HRESULT oznacza istotność błędu -- ma wartość 1 w
        ' przypadku błędu i 0 w przypadku powodzenia operacji. W tym przykładzie 
        ' obsługujemy błędy, a zatem można założyć, że pierwszy bit ma wartość 1.
        ' W zapisie szesnastkowym kodu HRESULT występuje zatem "8" (na przykład: &h800A03EC).
        Dim fac As String
        fac = Hex(hresult / &H10000 And &HFFFF)
        Select Case fac
            Case "0"
                Return "Success" ' HRESULT zwrócił sukces.
            Case "8002", "800A", "8004"
                Return "IDispatch" ' Zazwyczaj oznacza to Excela, Worda, etc.
            Case "8001"
                Return "RPC" ' Zazwyczaj oznacza to błąd współpracy (interop).
            Case "8003"
                Return "Pamięć" ' Mniej znaczące 16 bitów kodu HRESULT to kod błędu pliku DOS.
            Case "8007"
                Return "Win32" ' Błąd Win32 API.
            Case Else
                Return "Nieznany"
        End Select
    End Function

    ' Zwraca ostatnie 16 bitów kodu HRESULT (kod błędu).
    Function GetErrCode(ByVal hresult As Integer) As Integer
        Return hresult And &HFFFF
    End Function

    Private Sub cmdChangeCells_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdChangeCells.Click
        If Not SquareCells() Then _
            MsgBox("Operacja Excela nie powiodła się.")
    End Sub

    Private Function SquareCells() As Boolean
        Try
            ' Próba wyłączenia trybu interaktywnego.
            m_xl.Interactive = False
            ' Dla każdej komórki w wykorzystywanym zakresie aktywnego arkusza...
            For Each cel As Excel.Range In m_xl.ActiveSheet.UsedRange
                ' Podniesienie wartości do kwadratu.
                cel.Value = cel.Value ^ 2
            Next
        Catch ex As System.Runtime.InteropServices.COMException
            ' Coś się wydarzyło w Excelu.
            Debug.Fail(ex.Source & " " & Hex(ex.errorcode), ex.Message)
            Return False
        Catch ex As Exception
            ' Coś się wydarzyło w środowisku .NET (wyświetlenie błędu podczas debugowania)
            Debug.Fail(ex.Source, ex.Message)
            Return False
        Finally
            Try
                ' Próba włączenia trybu interaktywnego.
                m_xl.Interactive = True
            Catch ex As Exception
                ' Nie ma potrzeby wykonywania żadnych działań.
            End Try
        End Try
        ' Sukces.
        Return True
    End Function


    Function GetExcelVer() As String
        ' Definicja obiektów RegistryKey.
        Dim regRoot As RegistryKey, regExcel As RegistryKey, ver As String
        ' Pobranie korzenia rejestru.
        regRoot = Microsoft.Win32.Registry.ClassesRoot
        ' Pobranie z rejestru informacji o bieżącej wersji Excela.
        regExcel = regRoot.OpenSubKey("Excel.Application\CurVer")
        ' Jeśli regExcel wynosi Nothing, Excela nie zainstalowano.
        If IsNothing(regExcel) Then
            ' Zamknięcie klucza rejestru.
            regExcel.Close()
            ' Zwracenie 0, nie zainstalowano żadnej wersji
            ver = "0"
        Else
            ver = regExcel.GetValue("")
        End If
        ' Zamknięcie rejestru.
        regExcel.Close()
        ' Zwrócenie wersji Excela.
        Return ver
    End Function

End Class
