dcsimg
Results 1 to 9 of 9

Thread: Modify code to do Merge for Excel Cells and save excel file in xlsx extension

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Sep 2015
    Posts
    30

    Question 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

  2. #2
    .NUT jmcilhinney's Avatar
    Join Date
    May 2005
    Location
    Sydney, Australia
    Posts
    102,389

    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.

  3. #3

    Thread Starter
    Junior Member
    Join Date
    Sep 2015
    Posts
    30

    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

  4. #4
    .NUT jmcilhinney's Avatar
    Join Date
    May 2005
    Location
    Sydney, Australia
    Posts
    102,389

    Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension

    Quote Originally Posted by darby9621 View Post
    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 View Post
    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.

  5. #5
    Super Moderator RobDog888's Avatar
    Join Date
    Apr 2001
    Location
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™
    Posts
    60,651

    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.
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019

  6. #6
    Frenzied Member ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    1,919

    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
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  7. #7

    Thread Starter
    Junior Member
    Join Date
    Sep 2015
    Posts
    30

    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

  8. #8
    Fanatic Member
    Join Date
    Nov 2017
    Posts
    748

    Re: Modify code to do Merge for Excel Cells and save excel file in xlsx extension

    Quote Originally Posted by darby9621 View Post
    The code that I am using is very fast
    Max Power code?

    https://www.youtube.com/watch?v=7P0JM3h7IQk

  9. #9
    Karen Payne MVP kareninstructor's Avatar
    Join Date
    Jun 2008
    Location
    Oregon
    Posts
    6,449

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width