Modify code to do Merge for Excel Cells and save excel file in xlsx extension
Hi
I have this code to export list view to excel file it works fine, I want to do merge for similar cells in excel file (in my case will be Month name and location of the similar cells will be in A column ) and after that I want to save it as xlsx (now it accepts only xls format when I change it to xlsx format it gives me error(excel can't open the file .... because the file format or file extension is not valid)) this is my code
Code:
Dim FlNm As String = ""
Private Sub ExportToExcel(ByVal MyListView1 As ListView, ByVal MyListView2 As ListView, ByVal MyListView3 As ListView)
Dim fs As New StreamWriter(FlNm, False)
With fs
.WriteLine("<?xml version=""1.0""?>")
.WriteLine("<?mso-application progid=""Excel.Sheet""?>")
.WriteLine("<Workbook xmlns=""urn:schemas-microsoft-com:office:spreadsheet"">")
.WriteLine(" <Styles>")
.WriteLine(" <Style ss:ID=""hdr"">")
.WriteLine(" <Alignment ss:Horizontal=""Center""/>")
.WriteLine(" <Borders>")
.WriteLine(" <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
.WriteLine(" <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
.WriteLine(" <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
.WriteLine(" </Borders>")
.WriteLine(" <Font ss:FontName=""Calibri"" ss:Size=""11"" ss:Bold=""1""/>") 'SET FONT
.WriteLine(" </Style>")
.WriteLine(" <Style ss:ID=""ksg"">")
.WriteLine(" <Alignment ss:Vertical=""Bottom""/>")
.WriteLine(" <Borders/>")
.WriteLine(" <Font ss:FontName=""Calibri""/>") 'SET FONT
.WriteLine(" </Style>")
.WriteLine(" <Style ss:ID=""isi"">")
.WriteLine(" <Borders>")
.WriteLine(" <Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
.WriteLine(" <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
.WriteLine(" <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
.WriteLine(" <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>")
.WriteLine(" </Borders>")
.WriteLine(" <Alignment ss:Horizontal=""Center""/>")
.WriteLine(" <Font ss:FontName=""Calibri"" ss:Size=""10"" ss:Bold=""1""/>") 'SET FONT
.WriteLine(" </Style>")
.WriteLine(" </Styles>")
If MyListView1.Name = "Man Power & Job Info" Then
.WriteLine(" <Worksheet ss:Name=""Man Power & Job Info"">") 'SET SHEET Name
.WriteLine(" <Table>")
.WriteLine(" <Column ss:Width=""100""/>") 'Month & Year
.WriteLine(" <Column ss:Width=""50""/>") 'Date
.WriteLine(" <Column ss:Width=""84""/>") 'PM
.WriteLine(" <Column ss:Width=""84""/>") 'CM
.WriteLine(" <Column ss:Width=""84""/>") 'SS
.WriteLine(" <Column ss:Width=""84""/>") 'SD
.WriteLine(" <Column ss:Width=""100""/>") 'Man Power
End If
'AUTO SET HEADER
.WriteLine(" <Row ss:StyleID=""ksg"">")
For i As Integer = 0 To MyListView1.Columns.Count - 1 'SET HEADER
Application.DoEvents()
.WriteLine(" <Cell ss:StyleID=""hdr"">")
.WriteLine(" <Data ss:Type=""String"">{0}</Data>", MyListView1.Columns.Item(i).Text)
.WriteLine(" </Cell>")
Next
.WriteLine(" </Row>")
Dim Items1 As ListViewItem
For Each Items1 In MyListView1.Items
Application.DoEvents()
.WriteLine(" <Row ss:StyleID=""ksg"" ss:utoFitHeight =""0"">")
For intCol As Integer = 0 To Items1.SubItems.Count - 1
Application.DoEvents()
.WriteLine(" <Cell ss:StyleID=""isi"">")
.WriteLine(" <Data ss:Type=""String"">{0}</Data>", Items1.SubItems(intCol).Text)
.WriteLine(" </Cell>")
Next
.WriteLine(" </Row>")
Next
.WriteLine(" </Table>")
.WriteLine(" </Worksheet>")
.WriteLine("</Workbook>")
.Close()
End With
MsgBox("Exported Successfully.", MsgBoxStyle.Information)
End Sub
Thanks in advance
Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension
That's really not good code. Writing out XML as text like that is just so error-prone. If you want to create or edit an XLSX file then you should be using the OpneXML SDK and letting it worry about the specifics of the XML, while you worry about functionality.
Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension
The code works fine no errors at all but i am not able to do merge and also save it as XLSX format
Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension
Quote:
Originally Posted by
darby9621
The code works fine no errors at all
It works fine for one specific thing but making any changes to it is error prone. I could show you all sorts of code snippets that do what they are supposed to do but that doesn't make them good.
Quote:
Originally Posted by
darby9621
i am not able to do merge and also save it as XLSX format
Then the code doesn't work for what you want to do and you should write good code to do what you want to do properly.
Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension
Just because you are writing an xml file doesnt mean it will be a valid xlsx file if you change the file extension. I highly recommend using the open xml library for processing xlsx files as they need to be structured properly and also compressed. I dont see any compression code.
The OpenXML code library makes it so much easier and faster.
Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension
is there a reason why you don't export directly ?
like this
Code:
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'Listview befüllen
With ListView1
.Items.Clear()
.Columns.Clear()
.View = View.Details
.Columns.Add("Spalte 0")
.Columns.Add("Spalte 1")
.Columns.Add("Spalte 2")
.Columns.Add("Spalte 3")
.Columns.Add("Spalte 4")
For i As Integer = 0 To 50
Dim Li As New ListViewItem
Li.Text = "Item " & i.ToString & ".0"
For j As Integer = 0 To 3
Li.SubItems.Add("Item " & i.ToString & "." & (j + 1).ToString)
If (j = 1) And ((i Mod 2) = 1) Then
Exit For
End If
Next
.Items.Add(Li)
Next
.Refresh()
End With
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
SaveFileDialog1.Title = "Save Excel File"
SaveFileDialog1.Filter = "Excel Files (*.xlsx)|*.xlsx"
SaveFileDialog1.ShowDialog()
'exit if no file selected
If SaveFileDialog1.FileName = "" Then
Exit Sub
End If
'create objects to interface to Excel
Dim xls As New Excel.Application
Dim book As Excel.Workbook
Dim sheet As Excel.Worksheet
'create a workbook and get reference to first worksheet
xls.Workbooks.Add()
book = xls.ActiveWorkbook
sheet = book.ActiveSheet
'step through rows and columns and copy data to worksheet
Dim row As Integer = 2
Dim col As Integer = 1
'////////////////////////////////////////////////////////////////////////
Dim rowhead As Integer = 1
Dim colhead As Integer = 1
Dim columns As New List(Of String)
Dim columncount As Integer = ListView1.Columns.Count - 1
For i As Integer = 0 To columncount
sheet.Cells(rowhead, colhead) = ListView1.Columns(i).Text
colhead = colhead + 1
Next
'////////////////////////////////////////////////////////////////////////
For Each item As ListViewItem In ListView1.Items
For i As Integer = 0 To item.SubItems.Count - 1
sheet.Cells(row, col) = item.SubItems(i).Text
col = col + 1
Next
row += 1
col = 1
Next
'save the workbook and clean up
book.SaveAs(SaveFileDialog1.FileName)
xls.Workbooks.Close()
xls.Quit()
ReleaseComObject(sheet)
ReleaseComObject(book)
ReleaseComObject(xls)
End Sub
Private Sub ReleaseComObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension
The code that I am using is very fast
Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension
Quote:
Originally Posted by
darby9621
The code that I am using is very fast
Max Power code?
https://www.youtube.com/watch?v=7P0JM3h7IQk
Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension
Hello,
With how you are creating the file as already pointed out it's unwise and fragile performing this in a string. OpenXML is very fast yet for the newcomer to this method will be a daunting task so an alternative is to use a library that is in short, a wrapper for OpenXML e.g. SpreadSheetLight which is free, downside all examples are in C#.
Some VB.NET examples: Alternate methods for with Microsoft Excel in VB.NET projects
Note that none of the samples meet your exact requirements but instead offer suggestions to work from.
And there are two very basic examples, first one does a true merge.
Code:
'https://spreadsheetlight.com/sample-code/
Imports SpreadsheetLight
Imports DOS = DocumentFormat.OpenXml.Spreadsheet
Public Class Sample1
Public Sub Merge(pFileName As String)
Using doc As New SLDocument()
doc.SetCellValue("B2", "Karen")
doc.SetCellValue("B3", "Payne")
doc.SetCellValue("C3", "Oregon")
' merge all cells in the cell range B2:G8
doc.MergeWorksheetCells("B2", "G8")
doc.SetCellValue("B9", "Oregon")
doc.SaveAs(pFileName)
End Using
End Sub
''' <summary>
''' Dim ops = New Sample1
''' Dim names = CultureInfo.CurrentCulture.DateTimeFormat.DayNames.ToList()
''' ops.SimpleFormatting(Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "000.xlsx"), names)
''' </summary>
''' <param name="pFileName"></param>
''' <param name="pNameList"></param>
''' <returns></returns>
Public Function SimpleFormatting(pFileName As String, pNameList As List(Of String)) As Boolean
Using doc As New SLDocument()
Dim style1 As SLStyle = doc.CreateStyle
style1.Font.FontColor = Color.Pink
style1.Font.Strike = False
style1.Font.Underline = DOS.UnderlineValues.None
style1.Font.Bold = True
style1.Font.Italic = False
style1.Fill.SetPattern(DOS.PatternValues.Solid, Color.Black, Color.White)
style1.Alignment.Horizontal = DOS.HorizontalAlignmentValues.Right
doc.SetCellStyle("H2", style1)
doc.SetCellStyle("I2", style1)
doc.SetCellValue("H2", "Karen")
doc.SetCellValue("I2", "Payne")
Dim currencyStyle As SLStyle = doc.CreateStyle
currencyStyle.FormatCode = "$#,##0.000"
doc.SetCellValue("H3", 100.3)
doc.SetCellValue("I3", 200.5)
doc.SetCellStyle("H3", currencyStyle)
doc.SetCellStyle("I3", currencyStyle)
Dim dateStyle As SLStyle = doc.CreateStyle
dateStyle.FormatCode = "mm-dd-yyyy"
Dim dayNamesStyle As SLStyle = doc.CreateStyle
dayNamesStyle.Alignment.Horizontal = DOS.HorizontalAlignmentValues.Center
Dim dictDates As New Dictionary(Of String, Date) From
{
{"H4", #1/1/2017#},
{"H5", #1/2/2017#},
{"H6", #1/3/2017#},
{"H7", #1/4/2017#}
}
For Each dateItem In dictDates
If doc.SetCellValue(dateItem.Key, dateItem.Value) Then
doc.SetCellStyle(dateItem.Key, dateStyle)
doc.SetColumnWidth(dateItem.Key, 12)
End If
Next
Dim lastRow = doc.GetWorksheetStatistics().EndRowIndex
lastRow = If(lastRow = -1, 1, lastRow + 1)
For Each name In pNameList
doc.SetCellValue($"A{lastRow}", name)
doc.SetCellStyle($"A{lastRow}", dayNamesstyle)
lastRow += 1
Next
doc.AutoFitColumn("A")
doc.SaveAs(pFileName)
End Using
Return True
End Function
End Class