[Risolto] copia foglio in nuovo file
[Risolto] copia foglio in nuovo file
Premetto che sono alle prime esperienze con le macro in Basic e da questo vengono le mie difficoltà.
Ho un file .calc composto da 10 fogli, vorrei creare una macro che salvi il contenuto di un determinato foglio in un file con estensione .xls
come primo passo ho provato a creare un file .ods
Dopo diversi tentativi sono riuscito a creare una macro, che riporto sotto, che dovrebbe crerare un file .ods con il contenuto del foglio attivo, il file viene creato , ma vuoto.
Ci sto ammattendo senza esito se qualcuno mi può aiutare ve ne sarei grato.
sub copiafoglio
Dim Dummy()
Dim Url As String
Dim Doc As Object
Url = "private:factory/scalc"
Doc = StarDesktop.loadComponentFromURL(Url, "_blank", 0, Dummy())
Url = "file:///C:/scambio/pippo.ods"
Doc.storeAsURL(URL, Dummy())
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(2) as new com.sun.star.beans.PropertyValue
args1(0).Name = "DocName"
args1(0).Value = "pippo"
args1(1).Name = "Index"
args1(1).Value = 1
args1(2).Name = "Copy"
args1(2).Value = true
dispatcher.executeDispatch(document, ".uno:Move", "", 0, args1())
Doc.storeAsURL(URL, Dummy())
Doc.close(true)
end sub
Ho un file .calc composto da 10 fogli, vorrei creare una macro che salvi il contenuto di un determinato foglio in un file con estensione .xls
come primo passo ho provato a creare un file .ods
Dopo diversi tentativi sono riuscito a creare una macro, che riporto sotto, che dovrebbe crerare un file .ods con il contenuto del foglio attivo, il file viene creato , ma vuoto.
Ci sto ammattendo senza esito se qualcuno mi può aiutare ve ne sarei grato.
sub copiafoglio
Dim Dummy()
Dim Url As String
Dim Doc As Object
Url = "private:factory/scalc"
Doc = StarDesktop.loadComponentFromURL(Url, "_blank", 0, Dummy())
Url = "file:///C:/scambio/pippo.ods"
Doc.storeAsURL(URL, Dummy())
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(2) as new com.sun.star.beans.PropertyValue
args1(0).Name = "DocName"
args1(0).Value = "pippo"
args1(1).Name = "Index"
args1(1).Value = 1
args1(2).Name = "Copy"
args1(2).Value = true
dispatcher.executeDispatch(document, ".uno:Move", "", 0, args1())
Doc.storeAsURL(URL, Dummy())
Doc.close(true)
end sub
Ultima modifica di pittino il lunedì 28 settembre 2015, 8:25, modificato 1 volta in totale.
openoffice 4.1 con windows
Re: copia foglio in nuovo file
non è così semplice, prova questa
Codice: Seleziona tutto
Sub SaveSheet ' only one
Dim arg(0) as new com.sun.star.beans.PropertyValue
dim args1(2) as new com.sun.star.beans.PropertyValue
cFolder = "F:\Download\" ' <<<<<<<<<<<<< cartella destinazione
oDoc=thiscomponent
oSheets = oDoc.Sheets()
aSheetNames = oSheets.getElementNames()
Dim removeList(oSheets.getCount()) as String
index=2 ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> change index to save sheet >>>>>
oSheet = oSheets.getByIndex(index)
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
cNewFileName = aSheetNames(index)
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 <> cNewFileName 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
-------------------
Libre Office 7.5.3.2 su Windows 11
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Libre Office 7.5.3.2 su Windows 11
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Re: copia foglio in nuovo file
per prima cosa grazie per l'aiuto.
ho provato ad utilizzare la macro che restituisce il seguente errore:
errore runtime basic
si è verificata un'eccezione
type: com. sun.star.uno.runtimeexception
message:.
ed evidenzia la seguente riga:
newDoc.Sheets.removeByName( removeList(s))
chiusa la macro sono andato nella cartella di destinazione ed ho trovato un file con il nome di un foglio, ma vuoto e non capisco perchè quel foglio e non altri
grazie
ho provato ad utilizzare la macro che restituisce il seguente errore:
errore runtime basic
si è verificata un'eccezione
type: com. sun.star.uno.runtimeexception
message:.
ed evidenzia la seguente riga:
newDoc.Sheets.removeByName( removeList(s))
chiusa la macro sono andato nella cartella di destinazione ed ho trovato un file con il nome di un foglio, ma vuoto e non capisco perchè quel foglio e non altri
grazie
openoffice 4.1 con windows
Re: copia foglio in nuovo file
scusaaaaaa
funziona !!!
non avevo visto dove si imposta il foglio...
funziona !!!
non avevo visto dove si imposta il foglio...
openoffice 4.1 con windows
Re: copia foglio in nuovo file
ho provato ad aggiungere al nome del file il contenuto della cella b2 del foglio 0
inserendo questo codice:
Doc = Thiscomponent
Sheet = Doc.Sheets(0)
B2 = Sheet.getCellRangeByName("b2").string
.
.
.
cNewFileName = cNewFileName & B2
il file lo crea, ma vuoto perchè restituisce errore di runtime alla riga
newDoc.Sheets.removeByName( removeList(s))
dov'è che sbaglio ???
inserendo questo codice:
Doc = Thiscomponent
Sheet = Doc.Sheets(0)
B2 = Sheet.getCellRangeByName("b2").string
.
.
.
cNewFileName = cNewFileName & B2
il file lo crea, ma vuoto perchè restituisce errore di runtime alla riga
newDoc.Sheets.removeByName( removeList(s))
dov'è che sbaglio ???
openoffice 4.1 con windows
Re: copia foglio in nuovo file
Nel tuo caso nome file e foglio sono diversi quindi occorrono 2 variabili distinte
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
-------------------
Libre Office 7.5.3.2 su Windows 11
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Libre Office 7.5.3.2 su Windows 11
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Re: copia foglio in nuovo file
per spiegarmi meglio,
dopo aver raggiunto l'obbiettivo di creare un file che contiene i valori di un foglio con il suo nome, vorrei ottimizzare la procedure dando al file il nome del foglio e del contenuto della cella B2 del foglio1 sheet(0) dove c'è il mese di riferimento es: agosto ed il nome del foglio che ha ad esempio il nome di turni.
quindi pensando che la variabile cNewFileName aveva acquisito il valore di "turni, "
pensavo che se andavo a creare una variabile con il valore della cella B2 "agosto"
Doc = Thiscomponent
Sheet = Doc.Sheets(0)
B2 = Sheet.getCellRangeByName("b2").string
ed andavo ad aggiungerla alla variabile cNewFileName
cNewFileName = cNewFileName & B2
il tutto avesse funzionato ed invece restituisce errore e non capisco il motivo
dopo aver raggiunto l'obbiettivo di creare un file che contiene i valori di un foglio con il suo nome, vorrei ottimizzare la procedure dando al file il nome del foglio e del contenuto della cella B2 del foglio1 sheet(0) dove c'è il mese di riferimento es: agosto ed il nome del foglio che ha ad esempio il nome di turni.
quindi pensando che la variabile cNewFileName aveva acquisito il valore di "turni, "
pensavo che se andavo a creare una variabile con il valore della cella B2 "agosto"
Doc = Thiscomponent
Sheet = Doc.Sheets(0)
B2 = Sheet.getCellRangeByName("b2").string
ed andavo ad aggiungerla alla variabile cNewFileName
cNewFileName = cNewFileName & B2
il tutto avesse funzionato ed invece restituisce errore e non capisco il motivo
openoffice 4.1 con windows
Re: copia foglio in nuovo file
hai provato l'utimo codice allegato ?
-------------------
Libre Office 7.5.3.2 su Windows 11
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Libre Office 7.5.3.2 su Windows 11
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Re: [Risolto] copia foglio in nuovo file
Mea culpa se scrivo su un thread RISOLTO, ma non volevo riaprire un thread nuovo su un argomento già trattato (se invece fosse necessario, lo faccio subito). Il mio obiettivo è fare in modo che tutti i fogli presenti in un file Calc vengano copiati, comprensivi del loro contenuto, nel file calc aperto, quello da cui si esegue la macro. In pratica, vorrei che la macro eseguisse ciò che si fa dal menu "Inserisci" -> "Foglio da file" -> "Dopo il foglio corrente", per tutti i fogli del file. Questo post mi sembrava fare al caso mio, dal titolo, ma usando il secondo codice proposto da patel sono riuscito a ottenere la copia del solo foglio con indice stabilito da index (non degli altri) e comunque vuoto. Allego i due file calc, quello in cui si esegue la macro (Principale.ods) e quello dal quale devono essere copiati i fogli comprensivi del contenuto (OrigineDati.ods). Grazie mille!
Questo il codice usato:
EDIT: Mea culpa di nuovo ho riprovato e non so dove sbagliavo prima ma ora il codice di patel va! Riformulo comunque la mia domanda in questo modo: come si può modificare tale codice in modo da copiare tutti i fogli di un foglio contenuto in un certo file (OrigineDati.ods) nel file attualmente aperto e da cui si sta eseguendo la macro (Principale.ods)? Grazie e scusate!
Questo il codice usato:
Codice: Seleziona tutto
Sub SaveSheet ' only one
Dim arg(0) as new com.sun.star.beans.PropertyValue
dim args1(2) as new com.sun.star.beans.PropertyValue
cFolder = "F:\Download\" ' <<<<<<<<<<<<< cartella destinazione
oDoc=thiscomponent
oSheets = oDoc.Sheets()
aSheetNames = oSheets.getElementNames()
Dim removeList(oSheets.getCount()) as String
index=2 ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> change index to save sheet >>>>>
oSheet = oSheets.getByIndex(index)
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
cNewFileName = aSheetNames(index)
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 <> cNewFileName 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
- Allegati
-
- Principale.ods
- (8.82 KiB) Scaricato 136 volte
-
- OrigineDati.ods
- (8.86 KiB) Scaricato 147 volte
OpenOffice 3.1 su Windows 7
Re: [Risolto] copia foglio in nuovo file
il problema è un po' diverso e non è possibile riutilizzare/modificare le macro esposte in questa discussione, aprine una nuova con titolo adeguato in modo che rimanga traccia.
Domanda: i fogli del file originedati hanno nomi sicuramente diversi dall'unico foglio di Principale ?
Domanda: i fogli del file originedati hanno nomi sicuramente diversi dall'unico foglio di Principale ?
-------------------
Libre Office 7.5.3.2 su Windows 11
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Libre Office 7.5.3.2 su Windows 11
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Re: [Risolto] copia foglio in nuovo file
Sì, sicuramente i fogli in OrigineDati.ods hanno tutti un nome diverso rispetto all'unico fogliocontenuto in Principale.ods . Appena sono da PC provvedo a creare il post in questa sezione, grazie intanto.
OpenOffice 3.1 su Windows 7