PureBasic Forums - English

Code: Select all

EnableExplicit

#xlDoNotSaveChanges = 2

IncludePath "Your/Path/To/COMatePLUS-Folder"
XIncludeFile "COMatePLUS.pbi"

Define ClassID.CLSID
Define InstallationState.I

Procedure.I WriteListIconContentsIntoExcelSheet(ListIconID.I)
  Protected Cells.COMateObject
  Protected Column.I
  Protected ColumnsTotal.I
  Protected Excel.COMateObject
  Protected Result.I
  Protected Row.I
  Protected RowsTotal.I
  Protected Statement.I
  Protected Value.I
  Protected WorkBook.COMateObject
  Protected WorkSheet.COMateObject

  Excel = COMate_CreateObject("Excel.Application")
  
  If Excel = 0
    MessageRequester("Error",
      "The initialisation of the Excel application failed!",
      #MB_ICONERROR)
  Else
    If Excel\SetProperty("Visible = #True") <> #S_OK
      MessageRequester("Error",
        "The activation of the Excel application failed!",
        #MB_ICONERROR)
    Else
      WorkBook = Excel\GetObjectProperty("Workbooks\Add")
      
      If WorkBook = 0
        MessageRequester("Error",
          "The creation of the Excel workbook failed!",
          #MB_ICONERROR)
      Else
        RowsTotal = CountGadgetItems(ListIconID) + 1
        ColumnsTotal = GetGadgetAttribute(0, #PB_ListIcon_ColumnCount)
        Statement = COMate_PrepareStatement("Cells(" + Str(@Row) +
          " As Long BYREF," + Str(@Column) + " As Long BYREF) = " +
          Str(@Value) + " As String BYREF")

        If Statement = 0
          MessageRequester("Error",
            "The creation of the PrepareStatement in COMatePLUS failed!" +
            #CRLF$ + #CRLF$ + "COMatePLUS error: " +
            COMate_GetLastErrorDescription(),
            #MB_ICONERROR)
        Else
          For Row = 1 To RowsTotal
            For Column = 1 To ColumnsTotal
              Value = COMate_MakeBSTR(GetGadgetItemText(0, Row - 2,
                Column - 1))
              Excel\SetProperty("", Statement)
              SysFreeString_(value)
            Next Column
          Next Row

          ; ----- Set optimal column width
          
          WorkSheet = WorkBook\GetObjectProperty("ActiveSheet")
          Cells = WorkSheet\GetObjectProperty("Cells")
          Cells\SetProperty("EntireColumn\AutoFit = #True")
          
          COMate_FreeStatementHandle(Statement)
        EndIf

        WorkBook\Release()
      EndIf
    EndIf

    Excel\Invoke("Quit(" + #xlDoNotSaveChanges + ")")
    Excel\Release()
  EndIf

  ProcedureReturn Result
EndProcedure

CoInitialize_(0)
InstallationState = CLSIDFromProgID_(@"Excel.Application", @ClassID)
CoUninitialize_()

If InstallationState <> #S_OK
  MessageRequester("Program terminated",
    "Microsoft Excel is not installed!",
    #MB_ICONERROR)
  End
EndIf

OpenWindow(0, 200, 100, 350, 89, "ListIconGadget")
ListIconGadget(0, 5, 5, 340, 79, "Name", 100, #PB_ListIcon_GridLines)
AddGadgetColumn(0, 1, "Address", 236)
AddGadgetItem(0, -1, "Harry Rannit" + #LF$ +
  "12 Parliament Way, Battle Street, By the Bay")
AddGadgetItem(0, -1, "Ginger Brokeit" + #LF$ +
  "130 PureBasic Road, BigTown, CodeCity")
AddGadgetItem(0, -1, "Didi Findit" + #LF$ +
  "321 Logo Drive, Mouse House, Downtown")

If WriteListIconContentsIntoExcelSheet(0) <> -1
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf