Subroutine to export the selected rows of a ListView to Excel

[Jean-pierre Leroy]

Dear all,

I'm happy to share with you a simple routine to export automatically the selected rows of a ListView into Excel; you just need to pass the handle of the ListView and the name of the Excel sheet.

To use this subroutine you have to use the excellent xmlExcel library made by Paul SQUIRES:
http://www.planetsquires.com/protect/forum/index.php?topic=3208.msg23552#msg23552

Here is the subroutines:

Code Select Expand


Sub ListView_OpenInExcel(ByVal pListView As Dword, ByVal pSheetTitle As String)

    '----------------
    ' local variables
    '----------------
    Local lRow           As Long  ' lines number in Excel; start with line 1
    Local lIndex         As Long  ' index of the selected line in the ListView (0 based)
    Local lI             As Long               
    Local lTempPathW     As wStringZ*%MAX_PATH : GetTempPathW(%MAX_PATH, lTempPathW)
    Local lTempFileNameW As wStringZ*%MAX_PATH
    Local lTempFileNameS As String       
   
    '--------------------------------------------------------
    ' Create some interface variables to handle our Workbook,
    ' Worksheets, and individual Cells.
    '--------------------------------------------------------
    Local wb             As iExcelWorkBook
    Local ws             As iExcelWorkSheet
    Local iCell          As iExcelCell
    Local lCellColor     As String : lCellColor = "#E6D8AD" ' marron   
   
    ' create a name for a temporary file
    GetTempFileNameW(lTempPathW,"XLS",0,lTempFileNameW)
    lTempFileNameW = lTempFileNameW+".xml"
    lTempFileNameS = lTempFileNameW   
   
    ' Create a Workbook class
    Let wb = Class "clsExcelWorkBook"       
    wb.filename = lTempFileNameS
   
'    ' Assign some Workbook info. This stuff is optional.   
'    wb.author   = ""
'    wb.company  = ""

    ' Add a worksheet
    Let ws = wb.AddWorkSheet(pSheetTitle)
   
    ' Set some print parameters for this worksheet.
    ws.PageCenterVertical   = 1      ' default 0
    ws.PageCenterHorizontal = 1      ' default 0
    ws.PageLandscape        = %TRUE       
   
    '-------------------------
    ' to set the columns width
    '-------------------------     
    For lI = 1 To FF_ListView_GetColumnCount(pListView)
        ws.SetColumnWidth  lI,  FF_ListView_GetColumnWidth(pListView,lI-1)                   
    Next lI     

    '------------------------------
    ' write the Header (first line)
    '------------------------------
    Incr lRow               
    For lI = 1 To FF_ListView_GetColumnCount(pListView)
        iCell = ws.AddCell(lRow, lI, AC2UTF8(FF_ListView_GetColumnText(pListView,lI-1)))
        iCell.FontBold  = %TRUE
        iCell.CellColor = lCellColor
        Select Case FF_ListView_GetColumnAlignment(pListView,lI-1)
            Case %LVCFMT_RIGHT  : iCell.AlignRight  = %TRUE
            Case %LVCFMT_CENTER : iCell.AlignCenter = %TRUE
            Case %LVCFMT_LEFT   : iCell.AlignLeft   = %TRUE
        End Select           
    Next lI

    '--------------------------
    ' write the selected row(s)
    '--------------------------         
    lIndex = -1           
    Do           
   
        ' to get the next selected index
        lIndex = ListView_GetNextItem (pListView, lIndex, %LVNI_SELECTED)
       
        ' if we get the next index
        If lIndex <> -1 Then
       
            Incr lRow
            For lI = 1 To FF_ListView_GetColumnCount(pListView)                               
                Select Case FF_ListView_GetColumnAlignment(pListView,lI-1)
                    Case %LVCFMT_RIGHT                       
                        iCell = ws.AddCell(lRow, lI, Val(FF_ListView_GetItemText(pListView,lIndex,lI-1)))    ' assume rigt align cell contain number
                        iCell.AlignRight  = %TRUE
                    Case %LVCFMT_CENTER                       
                        iCell = ws.AddCell(lRow, lI, AC2UTF8(FF_ListView_GetItemText(pListView,lIndex,lI-1)))
                        iCell.AlignCenter = %TRUE
                    Case %LVCFMT_LEFT                       
                        iCell = ws.AddCell(lRow, lI, AC2UTF8(FF_ListView_GetItemText(pListView,lIndex,lI-1)))
                        iCell.AlignLeft   = %TRUE
                End Select           
            Next lI               
           
        End If                   
                     
    Loop Until lIndex = -1
   
    ' Write our workbook to disk
    wb.WriteXML
   
    ' Clean up after ourselves
    Set ws = Nothing
    Set wb = Nothing
   
    ' open the file
    ShellExecuteW(%HWND_DESKTOP, "open", lTempFileNameW, "", "", %SW_SHOWNORMAL)       
                 
End Sub


Regards,
Jean-Pierre

[Petrus Vorster]

Cool. Its so much smoother and easier to use than the one I tried some year or two ago.

Paul's library opened a whole new world to my programming.

What i still cant figure out though is that I tried to pass column widths from the Listview to the Excel sheet to avoid having to re-size the Excel sheet. That went real bad.
I still cant figure out some way to get them closer to each other.

Other things like Borders, Highlighted text and so forth I couldn't figure out either.
Its just me, but i like the work i do to look decent when i give it to someone. It freaks me out completely that i give someone a tool without some silly highlight or decent column width they don't even notice. But that's just me.

But yes, this library works like a charm. Thanks for your routine, it will sharpen up my work!

[Petrus Vorster]

This is not nearly as well put together as yours, but if someone has some ideas how one can calculate Excel column widths to resemble the widths one see in your listview, I will be most happy.

Code Select Expand

Function openexcel(mylist As Dword, task As String ) As Long
   
   Local wb       As iExcelWorkBook
   Local ws       As iExcelWorkSheet
   Local iCell    As iExcelCell
   Let wb = Class "clsExcelWorkBook"
   
   ' Assign some Workbook info. This stuff is optional.
   wb.filename = "Powerbox_Utilities.xml"
   'myfilename$ = wb.filename
   wb.author   = "Petrus Vorster"
   wb.company  = "Vorster Software CC"

   wb.DefaultFontName = "Calibri"
   wb.DefaultFontSize = 10

   Let ws = wb.AddWorkSheet("Sheet1")
   
   mycol& = FF_ListView_GetColumnCount(mylist)
     
   ' Set Column 4 to width 75.5 (in points)
   'ws.SetColumnWidth 1, 75
   Dim xheaders(0 To mycol&) As String
   For t& = 0 To mycol&-1
   xheaders(t&) = FF_ListView_GetColumnText(mylist,t&)
   mywidth&     = FF_ListView_GetColumnWidth(mylist,t&)
   iCell = ws.AddCell( 1, t&+1, xheaders(t&))
   icell.fontbold = 1 ' TRUE
   
   ws.SetColumnWidth t& + 1, mywidth&
   Next t&
   '---set elke column 
   Dim mydata As String
 
   totaal& = FF_ListView_GetItemCount(mylist)
   For colz& = 0 To mycol&-1
   For y& = 2 To totaal&+1
   mydata = FF_ListView_GetItemText(mylist,y&-2,colz&)
                                 
   iCell = ws.AddCell( y&,colz&+1, mydata)
   Next y&
   Next colz&
   
   iCell = ws.AddCell( y&+2,1, "Powerbox Utilities 2013. : " & DAX & " : " & Time$ )
   iCell.fontitalic = 1
   icell.fontbold   = 1
   icell.fontunderline = 1
   
   iCell = ws.AddCell( y&+3,1, "Task : " & task )
   iCell.fontitalic = 1
   icell.fontbold   = 1
   icell.fontunderline = 1
   
   wb.WriteXML
   
MsgBox "Information transferred to Excel.", %MB_OK  Or  %MB_ICONINFORMATION ,"Powerbox."


   ' Clean up after ourselves
   Set ws = Nothing
   Set wb = Nothing


stat& = ShellExecute (%HWND_DESKTOP, "Open","Powerbox_Utilities.xml" , $Nul, $Nul, %SW_SHOWNORMAL)

openexcel = 0
Exit Function
add_row:

Return
End Function

[Jean-pierre Leroy]

Dear all,

I forgot to post this subroutine that I use in my previous post (thanks Petrus)

Code Select Expand


Function AC2UTF8(ByVal pSource As String) As String
   
    Replace "à" With "Ã " In pSource
    Replace "â" With "â" In pSource
    Replace "é" With "é" In pSource
    Replace "è" With "è" In pSource
    Replace "ê" With "ê" In pSource
    Replace "ë" With "ë" In pSource
    Replace "î" With "î" In pSource
    Replace "ï" With "ï" In pSource
    Replace "ô" With "ô" In pSource
    Replace "ö" With "ö" In pSource
    Replace "ù" With "ù" In pSource
    Replace "û" With "û" In pSource
    Replace "ü" With "ü" In pSource
    Replace "ç" With "ç" In pSource
    Replace "Å"" With "Ã...“" In pSource
    Replace "Å"" With "Ã...“" In pSource   
    Replace "À" With "Ãâ,¬" In pSource
    Replace "Ã," With "Â" In pSource
    Replace "É" With "É" In pSource
    Replace "È" With "È" In pSource
    Replace "Ê" With "Ê" In pSource
    Replace "Ë" With "Ë" In pSource
    Replace "ÃŽ" With "ÃŽ" In pSource
    Replace "Ï" With "Ï"  In pSource
    Replace "Ã"" With "Ô" In pSource
    Replace "Ö" With "Ãâ€"" In pSource
    Replace "Ù" With "Ãâ,,¢" In pSource
    Replace "Û" With "Û" In pSource
    Replace "Ãœ" With "ÃÅ"" In pSource
    Replace "Ç" With "Ç" In pSource
    Replace "Å'" With "Ã...’" In pSource
                 
    ' HTML Entity Names
    Replace "<" With "&lt;"   In pSource
    Replace ">" With "&gt;"   In pSource
    Replace "°" With "&deg;"  In pSource
    Replace "â,¬" With "&euro;" In pSource
   
    ' textes mutlti-ligne
    Replace $CrLf With " " In pSource
    Replace $Cr   With " " In pSource
   
    ' la taille maximum d'une cellule Excel est de 32767 caractères
    If Len(pSource) > 32767 Then pSource = Left$(pSource, 32767)       
     
    Function = pSource
End Function


[Elias Montoya]

Code Select Expand

Function AC2UTF8(ByVal pSource As String) As String
   
Local Index as long

for Index = 1 to datacount
  replace PARSE$(READ$(Index), "|", 1)) with PARSE$(READ$(Index), "|", 2)), in pSource
Next Index
   
data "à|à ","â|â","é|é","è|è","ê|ê","ë|ë","î|î","ï|ï","ô|ô","ö|ö","ù|ù","û|û"
data "ü|ü","ç|ç","Å"|Ã...“","Å"|Ã...“","À|Ãâ,¬","Ã,|Â","É|É","È|È","Ê|Ê","Ë|Ë","ÃŽ|ÃŽ","Ï|Ã"
data "Ã"|Ô","Ö|Ãâ€"","Ù|Ãâ,,¢","Û|Û","Ãœ|ÃÅ"","Ç|Ç","Å'|Ã...’","<|&lt;",">|&gt;","°|&deg;","â,¬|&euro;"
data "??| ","?| "
   
Function = IIF$(Len(pSource)>32767, Left$(pSource, 32767), pSource)

End Function