Imports System.Windows.Forms
Imports Office = Microsoft.Office.Core
Imports Excel = Microsoft.Office.Interop.Excel
Imports MSForms = Microsoft.Vbe.Interop.Forms

' Atrybut integracji z pakietem Office. Identyfikuje klasę startową dla skoroszytu. Nie modyfikować.
<Assembly: System.ComponentModel.DescriptionAttribute("OfficeStartupClass, Version=1.0, Class=r01net.OfficeCodeBehind")> 

Public Class OfficeCodeBehind

    Friend WithEvents ThisWorkbook As Excel.Workbook
    Friend WithEvents ThisApplication As Excel.Application
    ' Utworzenie zmiennej obiektowej w celu pobrania zdarzeń z przycisku.
    Friend WithEvents cmdEditList As MSForms.CommandButton
    Friend WithEvents cmdEditList2 As MSForms.CommandButton

#Region "Generated initialization code"

    ' Default constructor.
    Public Sub New()
    End Sub

    ' Required procedure. Do not modify.
    Public Sub _Startup(ByVal application As Object, ByVal workbook As Object)
        ThisApplication = CType(application, Excel.Application)
        ThisWorkbook = CType(workbook, Excel.Workbook)


    End Sub

    ' Required procedure. Do not modify.
    Public Sub _Shutdown()
        ThisApplication = Nothing
        ThisWorkbook = Nothing
    End Sub

    ' Returns the control with the specified name on ThisWorkbook's active worksheet.
    Overloads Function FindControl(ByVal name As String) As Object
        Return FindControl(name, CType(ThisWorkbook.ActiveSheet, Excel.Worksheet))
    End Function

    ' Returns the control with the specified name on the specified worksheet.
    Overloads Function FindControl(ByVal name As String, ByVal sheet As Excel.Worksheet) As Object
        Dim theObject As Excel.OLEObject
        Try
            theObject = CType(sheet.OLEObjects(name), Excel.OLEObject)
            Return theObject.Object
        Catch Ex As Exception
            ' Returns Nothing if the control is not found.
        End Try
        Return Nothing
    End Function
#End Region

    ' Wywoływana podczas otwierania skoroszytu.
    Private Sub ThisWorkbook_Open() Handles ThisWorkbook.Open
        ' Zainicjowanie zmiennej przycisku w celu obserwacji zdarzeń.
        cmdEditList = CType(FindControl("cmdEditList"), _
          MSForms.CommandButton)
        cmdEditList2 = CType(FindControl("cmdEditList2"), _
          MSForms.CommandButton)
    End Sub

    ' Wywoływana przed zamknięciem skoroszytu. Zwróćmy uwagę, że ta metoda
    ' może być wywoływana wiele razy, a wartość przypisana do zmiennej Cancel
    ' może zostać zignorowana w przypadku interwencji użytkownika lub innego kodu.
    ' Kiedy zachodziu zdarzenie, zmienna Cancel ma wartość False. Jeśli procedura obsługi zdarzenia
    ' ustawi ją na True, dokument nie zamknie się po zakończeniu procedury.
    Private Sub ThisWorkbook_BeforeClose(ByRef Cancel As Boolean) Handles ThisWorkbook.BeforeClose
        Cancel = False
    End Sub

    ' Przykład procedury AfterXmlImport.
    Private Sub ThisWorkbook_AfterXmlImport( _
      ByVal Map As Microsoft.Office.Interop.Excel.XmlMap, _
      ByVal IsRefresh As Boolean, _
      ByVal Result As Microsoft.Office.Interop.Excel.XlXmlImportResult) _
      Handles ThisWorkbook.AfterXmlImport
        ' Wstaw (usuń) komentarz w poniższych wywołaniach procedur, aby wypróbować
        ' różne przykłady procedury obsługi zdarzenia AfterXmlImport.
        'ex1_AfterXmlImport()
        ex2_AfterXmlImport()
    End Sub

    ' Pierwszy przykład .NET - utworzenie komentarzy z ukrytej kolumny docstring.
    Sub ex1_AfterXmlImport()
        Dim cel As Excel.Range, ws As Excel.Worksheet, rng As Excel.Range
        ' Utworzenie obiektu usługi sieciowej.
        Dim rowID As Integer
        ws = ThisWorkbook.Worksheets("Arkusz1")
        rng = ws.ListObjects("Lista1").ListColumns("name").Range
        ' Zmiana z For Each kodu VBA ze względu na problemy z kolekcją Range Excela.
        For rowID = 1 To rng.Rows.Count - 1
            ' Pobranie obiektu Range o rozmiarze jednej komórki dla każdego wiersza w kolumnie name.
            cel = ws.Cells(rowID + rng.Row, rng.Column)
            If Not (cel.Comment Is Nothing) Then cel.Comment.Delete()
            cel.AddComment(cel.Offset(0, 1).Text)
        Next
    End Sub

    ' Drugi, bardziej złożony przykład, w którym wykorzystano usługę sieciową serwera SharePoint Lists
    ' w celu pobrania załączników i dodania do nich hiperłączy.
    ' Aby skorzystac z tego przykładu, należy: udostępnić listę jako "Obiekty Excela" na
    ' serwerze SharePoint, a następnie zmodyfikować właściwość URL obiektu ListsWS tak, aby wskazywała
    ' na adres serwera SharePoint.
    ' 
    ' W przypadku pozostawienia bieżącego ustawienia ListWS (http://mstrainingkits.no-ip.info/)
    ' można zalogować się na tym serwerze za pomocą nazwy użytkownika "ExcelDemo" i hasłem "Excel2003"
    Sub ex2_AfterXmlImport()
        Dim cel As Excel.Range, ws As Excel.Worksheet, rng As Excel.Range
        ' Utworzenie obiektu usługi sieciowej.
        Dim lws As New ListsWS.Lists, xn As System.Xml.XmlNode, rowID As Integer
        ws = ThisWorkbook.Worksheets("Arkusz1")
        rng = ws.ListObjects("Lista1").ListColumns("name").Range
        ' Przekazanie danych uwierzytelniania aplikacji do usługi sieciowej.
        lws.Credentials = System.Net.CredentialCache.DefaultCredentials
        ' Aby można było pracować z serwerem http://mstrainingkits.no-ip.info/
        lws.AllowAutoRedirect = True
        ' Zmiana z For Each z powodu problemów z kolekcją Range Excela.
        For rowID = 1 To rng.Rows.Count - 2
            ' Pobranie obiektu Range o rozmiarze jednej komórki dla każdego wiersza w kolumnie name.
            cel = ws.Cells(rowID + rng.Row, rng.Column)
            If Not (cel.Comment Is Nothing) Then cel.Comment.Delete()
            cel.AddComment(cel.Offset(0, 1).Text)
            Try
                ' Pobranie listy załączników za pomocą usługi sieciowej Lists serwera SharePoint.
                xn = lws.GetAttachmentCollection("Obiekty Excela", rowID)
                ' Jeśli jest załącznik 
                If Not IsNothing(xn.Item("Attachment")) Then
                    ' Dodanie hiperłącza dla załącznika
                    ws.Hyperlinks.Add(cel.Offset(0, 2), _
                      xn.Item("Attachment").InnerText, , _
                      "Kliknij, aby obejrzeć kod", _
                      "Przykład kodu")
                End If
            Catch ex As Exception
                MsgBox("Błąd dostępu do listy SharePoint: " & _
                 ex.Message)
            End Try
        Next
    End Sub

    ' Wyeksportowanie listy do pliku XML, a następnie otwarcie jej do edycji
    ' za pomocą formularza InfoPath.
    Private Sub cmdEditList_Click() Handles cmdEditList.Click
        ' Wyeksportowanie listy (aby upewnić się, że dane są aktualne).
        Dim ws As Excel.Worksheet, pth As String, ippth As String, xmlObj = "", xmlData As String
        pth = ThisWorkbook.Path
        ws = ThisWorkbook.Worksheets("Arkusz1")
        ' Pobranie danych XML z listy.
        ws.ListObjects("Lista1").XmlMap.ExportXml(xmlObj)
        ' Przekształcenie na ciąg znaków (w celu obejścia pewnych osobliwości obiektu COM Excela).
        xmlData = CType(xmlObj, String)
        ' Edycja dokumentu XML w celu wprowadzenia instrukcji przetwarzania programu InfoPath.
        Dim ipinst As System.IO.StreamReader
        ipinst = System.IO.File.OpenText(pth & "\ipinst.txt")
        xmlData = xmlData.Replace("<application>", ipinst.ReadToEnd)
        ipinst.Close()
        ' Zapisanie zmodyfikowanego pliku XML na dysk.
        Dim xmlFile As New System.IO.StreamWriter(pth & "\ExcelObjectsList.xml", False)
        xmlFile.Write(xmlData)
        xmlFile.Close()
        ' Uruchomienie InfoPath i zaimportowanie danych.
        Dim ip As New Microsoft.Office.Interop.InfoPath.ExternalApplication
        ' Otwarcie nowego formularza na podstawie szablonu.
        ip.Open(pth & "\ExcelObjectsList.xml")
    End Sub


    ' Sposób alternatywny - wykorzystanie strumienia XML zamiast pliku.
    Private Sub cmdEditList2_Click() Handles cmdEditList2.Click
        Dim ws As Excel.Worksheet, xmlObj = "", xmlData As String
        Dim ip As New Microsoft.Office.Interop.InfoPath.Application
        Dim xDom As Microsoft.Office.Interop.InfoPath.Xml.IXMLDOMDocument
        Dim pth As String = ThisWorkbook.Path
        ws = ThisWorkbook.Worksheets("Arkusz1")
        ' Pobranie danych XML z listy.
        ws.ListObjects("Lista1").XmlMap.ExportXml(xmlObj)
        ' Przekształcenie na ciąg znaków (w celu obejścia pewnych osobliwości obeiktu COM Excela).
        xmlData = CType(xmlObj, String)
        ' Pobranie informacji o folderze szablonu InfoPath.
        pth = System.IO.Path.GetFullPath("..\..") & "\r01ipnet"
        ' Utworzenie nowego formularza na podstawie szablonu.
        ip.XDocuments.NewFromSolution(pth & "\manifest.xsf")
        ' Utworzenie elementu w dokumencie.
        xDom = ip.XDocuments(0).CreateDOM
        ' Załadowanie danych.
        xDom.loadXML(xmlData)
        ' Zaimportowanie załadowanych danych do nowego formularza.
        ip.XDocuments(0).ImportDOM(xDom)
    End Sub

End Class
