Imports System.IO Imports XLSLib Friend Module TVToExcel Dim level As Integer = 0 Dim ExcelData As New DataTable Dim Leveldata() As String Dim xls As New XLSLib.clsXLSLib Sub Addrow_v(ByVal level As Integer, Optional ByVal Typ As String = "") Dim dr As DataRow dr = ExcelData.NewRow For i As Integer = 0 To level dr.Item(i) = Leveldata(i) Next ExcelData.Rows.Add(dr) End Sub Sub Addrow(ByVal level As Integer, Optional ByVal Typ As String = "") Dim dr As DataRow dr = ExcelData.NewRow dr.Item(0) = Typ For i As Integer = 0 To level dr.Item(i + 1) = Leveldata(i) Next ExcelData.Rows.Add(dr) End Sub Sub Export_Vertragselemente(ByVal tv As TreeView, ByVal filename As String) Dim s As String = " ; ; ; ; ; ; ; ; ; ;" Leveldata = s.Split(";") ExcelData.Rows.Clear() ExcelData.Columns.Clear() ExcelData.Columns.Add("Element1") ExcelData.Columns.Add("Element2") ExcelData.Columns.Add("Element3") ExcelData.Columns.Add("Element4") ExcelData.Columns.Add("Element5") ExcelData.Columns.Add("Element6") ExcelData.Columns.Add("Element7") ExcelData.Columns.Add("Element8") For Each xx As TreeNode In tv.Nodes level = 0 Leveldata(level) = xx.Text Addrow_v(level) treedown(xx) s = " ; ; ; ; ; ; ; ; ; ;" Leveldata = s.Split(";") Next level = 0 Leveldata(level) = "" Addrow(level) Leveldata(level) = "Legende:" Addrow(level) Leveldata(level) = "***... = Inaktives Element" Addrow(level) xls.Write_Excel(ExcelData, True) 'DatatableToExcel(ExcelData, filename) End Sub Sub treedown(ByVal xx As TreeNode) For Each xy As TreeNode In xx.Nodes level = level + 1 Dim fnt As Font = xy.NodeFont If fnt.Strikeout = True Then Leveldata(level) = "*** " + xy.Text Else Leveldata(level) = xy.Text If Not xy.ImageIndex = 9 Then Addrow_v(level, "") End If treedown(xy) level = level - 1 Next End Sub Sub Export_Applikationen(ByVal tv As TreeView, ByVal filename As String) Dim s As String = " ; ; ; ; ; ; ; ; ; ;" Leveldata = s.Split(";") ExcelData.Rows.Clear() ExcelData.Columns.Clear() ExcelData.Columns.Add("Typ") ExcelData.Columns.Add("Element1") ExcelData.Columns.Add("Element2") ExcelData.Columns.Add("Element3") ExcelData.Columns.Add("Element4") ExcelData.Columns.Add("Element5") ExcelData.Columns.Add("Element6") ExcelData.Columns.Add("Element7") ExcelData.Columns.Add("Element8") For Each xx As TreeNode In tv.Nodes level = 0 ' Leveldata(level) = xx.Text If xx.ImageIndex = 2 Or xx.ImageIndex = 4 Or xx.ImageIndex = 6 Then Leveldata(level) = "*** " + xx.Text Else Leveldata(level) = xx.Text If xx.ImageIndex = 1 Then Addrow(level, "") If xx.ImageIndex = 3 Then Addrow(level, "L") If xx.ImageIndex = 5 Then Addrow(level, "S") If xx.ImageIndex = 2 Then Addrow(level, "") If xx.ImageIndex = 4 Then Addrow(level, "L") If xx.ImageIndex = 6 Then Addrow(level, "S") treedown1(xx) s = " ; ; ; ; ; ; ; ; ; ;" Leveldata = s.Split(";") Next level = 0 Leveldata(level) = "" Addrow(level) Leveldata(level) = "Legende:" Addrow(level) Leveldata(level) = "***... = Inaktives Element" Addrow(level) Leveldata(level) = "Typ '' = Applikation/Modul" Addrow(level) Leveldata(level) = "Typ 'L' = Lizenzelement" Addrow(level) Leveldata(level) = "Typ 'S' = Strukturelement" Addrow(level) xls.Write_Excel(ExcelData, True) ' DatatableToExcel(ExcelData, filename) End Sub Sub treedown1(ByVal xx As TreeNode) For Each xy As TreeNode In xx.Nodes level = level + 1 Dim fnt As Font = xy.NodeFont If xy.ImageIndex = 2 Or xy.ImageIndex = 4 Or xy.ImageIndex = 6 Then Leveldata(level) = "*** " + xy.Text Else Leveldata(level) = xy.Text If xy.ImageIndex = 1 Then Addrow(level, "") If xy.ImageIndex = 3 Then Addrow(level, "L") If xy.ImageIndex = 5 Then Addrow(level, "S") If xy.ImageIndex = 2 Then Addrow(level, "") If xy.ImageIndex = 4 Then Addrow(level, "L") If xy.ImageIndex = 6 Then Addrow(level, "S") treedown1(xy) level = level - 1 Next End Sub Function DatatableToExcel(ByVal aDataTable As DataTable, ByVal aOutputFilename As String) As Boolean Application.DoEvents() Dim f As New FrmFortschritt Dim app As New Object Dim wb As New Object Dim ws As New Object Try f.Show() Application.DoEvents() f.ProgressBar1.Minimum = 0 f.ProgressBar1.Maximum = aDataTable.Rows.Count f.ProgressBar1.Step = 1 app = CreateObject("Excel.application") 'Dim wb As Object 'Dim ws As Object ' Dim app As New Excel.ApplicationClass ' Dim wb As Excel.Workbook ' Dim ws As Excel.Worksheet wb = app.Workbooks.add() 'wb = app.Workbooks.Add() ws = wb.ActiveSheet() Dim dc As DataColumn Dim dr As DataRow Dim colIndex As Integer Dim rowIndex As Integer ' Columns erstellen For Each dc In aDataTable.Columns colIndex += 1 app.Cells(1, colIndex) = dc.ColumnName Next For Each dr In aDataTable.Rows f.ProgressBar1.PerformStep() rowIndex += 1 colIndex = 0 For Each dc In aDataTable.Columns colIndex += 1 app.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName) Next Next ws.Columns.AutoFit() wb.SaveAs(aOutputFilename) app.Workbooks.Open(aOutputFilename) ' Excel anzeigen wenn fertig exportiert app.Visible = True ws = Nothing wb = Nothing app = Nothing f.Close() Return True Catch ex As Exception f.Close() MsgBox(ex.Message) End Try End Function End Module