[Risolto] Convertire in xls

[pittino]

Con il grande aiuto di Patel avevo risolto il problema che avevo, trasferire i dati di un foglio in un nuovo file, con la seguente macro.
il file che crea la macro è in formato "ods" .
La procedura che utilizzo per importare automaticamente i dati creati non lo riconosce, perchè legge solo file excel.
Per poterci lavorare devo aprire i file creati e salvarli in formato Xls, siccome i file sono diversi, c'è un modo per salvare direttamente in formato xls direttamente dalla macro ??

grazie a chi mi può aiutare

Codice: Seleziona tutto

Sub SaveSheet1' only one  ' only one nome file diverso da nome foglio
Dim arg(0) as new com.sun.star.beans.PropertyValue
dim args1(2) as new com.sun.star.beans.PropertyValue

   cFolder = "F:\Download\"
   oDoc=thiscomponent
   oSheets = oDoc.Sheets()
   aSheetNames = oSheets.getElementNames()
   Dim removeList(oSheets.getCount()) as String
   index=2 ' >>>> change index to save sheet >>>>>
      SheetName = aSheetNames(index)
      oSheet = oSheets.getByIndex(index)
      dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
      cNewFileName= SheetName & oSheet.getCellRangeByName("b2").string      
      cNewFileName = Replace(cNewFileName, " ", "_") ' Replace spaces with underscores
      oController = oDoc.GetCurrentController()  'view controller
      oController.SetActiveSheet(oSheet) 'switches view to sheet object
      document   = oDoc.CurrentController.Frame
      newDoc = StarDesktop.loadComponentFromURL("private:factory/scalc" ,"_blank", 0, Arg() )
      newDoc.StoreAsURL(ConvertToUrl(cFolder  + cNewFileName + ".ods" ), arg() )
     args1(0).Name = "DocName"
     args1(0).Value = cNewFileName
     args1(1).Name = "Index"
     args1(1).Value = 1
     args1(2).Name = "Copy"
     args1(2).Value = true
     dispatcher.executeDispatch(document, ".uno:Move", "", 0, args1())
     for s = 0 to newDoc.Sheets.Count - 1
        sheet = newDoc.Sheets(s)
      if sheet.Name <>  SheetName then
        removeList(s) = sheet.Name
      else
         removeList(s) = ""
      end if
     next s
'Remove all sheets apart from the active one
     for s = 0 to ubound(removeList)
      if removeList(s) <> "" then
        newDoc.Sheets.removeByName( removeList(s))
      end if
     next s
      newDoc.Store
      newDoc.close(true)
End Sub

[Gaetanopr]

Prova con questa

Codice: Seleziona tutto

Sub SaveSheet1' only one  ' only one nome file diverso da nome foglio
Dim arg(0) as new com.sun.star.beans.PropertyValue
dim args1(2) as new com.sun.star.beans.PropertyValue

   cFolder = "F:\Download\"
   oDoc=thiscomponent
   oSheets = oDoc.Sheets()
   aSheetNames = oSheets.getElementNames()
   Dim removeList(oSheets.getCount()) as String
   index=2 ' >>>> change index to save sheet >>>>>
      SheetName = aSheetNames(index)
      oSheet = oSheets.getByIndex(index)
      dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
      cNewFileName= SheetName & oSheet.getCellRangeByName("b2").string      
      cNewFileName = Replace(cNewFileName, " ", "_") ' Replace spaces with underscores
      oController = oDoc.GetCurrentController()  'view controller
      oController.SetActiveSheet(oSheet) 'switches view to sheet object
      document   = oDoc.CurrentController.Frame
      newDoc = StarDesktop.loadComponentFromURL("private:factory/scalc" ,"_blank", 0, Arg() )
    
      Dim args(0) as new com.sun.star.beans.PropertyValue
      args(0).Name = "FilterName"         
      args(0).Value = "MS Excel 97"       
      newDoc.StoreAsURL(ConvertToUrl(cFolder  + cNewFileName + ".xls" ), args() )
     
     args1(0).Name = "DocName"
     args1(0).Value = cNewFileName
     args1(1).Name = "Index"
     args1(1).Value = 1
     args1(2).Name = "Copy"
     args1(2).Value = true
     dispatcher.executeDispatch(document, ".uno:Move", "", 0, args1())
     for s = 0 to newDoc.Sheets.Count - 1
        sheet = newDoc.Sheets(s)
      if sheet.Name <>  SheetName then
        removeList(s) = sheet.Name
      else
         removeList(s) = ""
      end if
     next s
'Remove all sheets apart from the active one
     for s = 0 to ubound(removeList)
      if removeList(s) <> "" then
        newDoc.Sheets.removeByName( removeList(s))
      end if
     next s
      newDoc.Store
      newDoc.close(true)
End Sub

[pittino]

Per prima cosa grazie per l'aiuto

ho provato a fare la modifica proposta, ma restituisce il seguente errore:

ho eliminato la riga perchè la variabile era già stata impostata, ma restituisce un ulteriore errore:

e non capisco il motivo

[Gaetanopr]

Sicuramente avrai nella macro qualche altra variabile args, quindi ti basta cambiare nome

Codice: Seleziona tutto

    Sub SaveSheet1' only one  ' only one nome file diverso da nome foglio
    Dim arg(0) as new com.sun.star.beans.PropertyValue
    dim args1(2) as new com.sun.star.beans.PropertyValue

       cFolder = "F:\Download\"
       oDoc=thiscomponent
       oSheets = oDoc.Sheets()
       aSheetNames = oSheets.getElementNames()
       Dim removeList(oSheets.getCount()) as String
       index=2 ' >>>> change index to save sheet >>>>>
          SheetName = aSheetNames(index)
          oSheet = oSheets.getByIndex(index)
          dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
          cNewFileName= SheetName & oSheet.getCellRangeByName("b2").string     
          cNewFileName = Replace(cNewFileName, " ", "_") ' Replace spaces with underscores
          oController = oDoc.GetCurrentController()  'view controller
          oController.SetActiveSheet(oSheet) 'switches view to sheet object
          document   = oDoc.CurrentController.Frame
          newDoc = StarDesktop.loadComponentFromURL("private:factory/scalc" ,"_blank", 0, Arg() )
       
          Dim argomento(0) as new com.sun.star.beans.PropertyValue
          argomento(0).Name = "FilterName"         
          argomento(0).Value = "MS Excel 97"       
          newDoc.StoreAsURL(ConvertToUrl(cFolder  + cNewFileName + ".xls" ), argomento() )
         
         args1(0).Name = "DocName"
         args1(0).Value = cNewFileName
         args1(1).Name = "Index"
         args1(1).Value = 1
         args1(2).Name = "Copy"
         args1(2).Value = true
         dispatcher.executeDispatch(document, ".uno:Move", "", 0, args1())
         for s = 0 to newDoc.Sheets.Count - 1
            sheet = newDoc.Sheets(s)
          if sheet.Name <>  SheetName then
            removeList(s) = sheet.Name
          else
             removeList(s) = ""
          end if
         next s
    'Remove all sheets apart from the active one
         for s = 0 to ubound(removeList)
          if removeList(s) <> "" then
            newDoc.Sheets.removeByName( removeList(s))
          end if
         next s
          newDoc.Store
          newDoc.close(true)
    End Sub

[pittino]

Perfetto..

funziona perfettamente grazie mille !!!