Aiuto modifica macro copia dati con formattazioni

[Romio83]

Saluti a tutti, ho un problema con una macro che prevede la copia di un determinato intervallo di celle da un foglio a un altro foglio di un nuovo file chiamato "archivio".
Il problema è che non mi copia le formattazioni ma solo i dati.
Tramite il registatore di macro ho tentato un'altra strada che ho poi abbandonato.. coppiavo il foglio e lo incollavo nel nuovo foglio del nuovo file, e si mi copiava le formattazioni ma mi metteva i riferimenti di celle da un foglio a un altro mentre io vorrei inserire solo i dati, pertanto ho lasciato stare.

Detto cio vorrei sapere se esiste un comando per copiare non solo i dati ma anche le formattazioni dello stesso intervallo.
in allegato metto il "file prova" a chi volesse dare un occhiata, grazie a tutti per il Vostro eventuale tempo e aiuto

[charlie]

Ciao e benvenuto sul forum.
Se intanto ti vuoi presentare, farai cosa gradita. Puoi farlo in questa sezione -> viewforum.php?f=16
Se desideri avere una panoramica delle regole del forum puoi consultare il Manuale di sopravvivenza -> http://forum.openoffice.org/it/forum/vi ... hp?f=1&t=2

Buon proseguimento.

[patel]

Da quanto ho capito vuoi copiare la formattazione ma non le formule, io so copiare o solo i dati o tutto

[Romio83]

Da quanto ho capito vuoi copiare la formattazione ma non le formule, io so copiare o solo i dati o tutto

E si è proprio lì l'inghippo infatti la macro nel "
file prova" in allegato copia solo i dati ma senza la formattazione.

[Romio83]

Questa è la macro a cui sto lavorando, presente nel "File Prova" in allegato.

Codice: Seleziona tutto

REM  *****  BASIC  *****
sub MaIN
Dim DocName as object, DocUlr as string, dummy(), range as object
Doc = ThisComponent
Sheet=Doc.Sheets.getByName("FoglioDaCopiareSenzaFormule")
Cell = Sheet.getCellRangeByName("H5")
Controller = Doc.getcurrentController
Controller.setActiveSheet(sheet)
Sheet.getCellRangeByName("H5").value= Sheet.getCellRangeByName("H5").value + 1
Sheet = Doc.Sheets(0)
Range = Sheet.getCellRangeByName("F1:H150").getDataArray ' range da copiare
REM --------CREARE IL FILE DA SU CUI COPIARE--------------------
Dim arg(0) as new com.sun.star.beans.PropertyValue
	Fogli = ThisComponent.Sheets()
	Foglio = Fogli.getByIndex(0)	
	NuovoFile = StarDesktop.loadComponentFromURL("private:factory/scalc" ,"_blank", 0, Arg())
	NuovoFile.StoreAsURL(ConvertToUrl("C:\Users\USER\Desktop\ARCHIVIO.ods" ), arg())  '                <---------PERCORSO DA MODIFICARE 
	sheet = NuovoFile.Sheets(0)
NuovoFile.Close(true)
'-----------------------------------------------------------------------------------------------------------------------------------------------


REM ------------------------RI APERTURA FILE APPENA CREATO PER LA COPPIA DEI DATI-----------------------
'  probabilmente si potrebbe pure evitare di chiuderlo e riaprirlo!!! ho fatto cosi almeno non mi da errore se il file non esiste.
'  ho provato anche tramite il "registratore di macro" a copiare il foglio sul file di destinazione ARCHIVIO e mi copia le formattazioni, ma non i dati. Si vedono solo i riferimenti di celle da questo documento
'

sFileName ="C:\Users\USER\Desktop\ARCHIVIO.ods"   ' file destinazione
DocUrl = ConvertToURL(sFileName)
DocName = StarDesktop.loadComponentFromURL (DocUrl, "_blank",0, Dummy() )
archivio = DocName.Sheets("COPIA FILE PROVA")
Cursore = Archivio.createCursor
Cursore.gotoEndOfUsedArea(false)
UltimaRiga = Cursore.RangeAddress.EndRow
dRange  = Archivio.getCellRangeByName("A1:C150") ' range destinazione---------- C'è un comando per copiare nel RANGE anche le formattazioni?
dRange.setDataArray(Range)
DocName.store
DocName.Close(true)
'-----------------------------------------------------------------------------------------------------------------------------------------------------
End Sub

[lucky63]

L'uovo di colombo ?!?

Potresti rendere tutto semplice, molto più semplice formattando già prima il foglio ricevente come quello originario (o simile o come preferisci) predisponendo la macro per copiare l'intero range originario (le sole righe di dati interessate esclusa l'intestazione o anche con l'intestazione).

Oppure potresti formattarlo nella sola intestazione e nella prima riga vuota sottostante predisponendo la macro affinché copy i dati tabellari originari riga per riga e che ad ogni operazione inserisca dopo l'ultima riga una nuova riga vuota (che assumerà automaticamente le caratteristiche di quella precedente) ...

[Romio83]

L'uovo di colombo ?!?

Potresti rendere tutto semplice, molto più semplice formattando già prima il foglio ricevente come quello originario (o simile o come preferisci) predisponendo la macro per copiare l'intero range originario (le sole righe di dati interessate esclusa l'intestazione o anche con l'intestazione).

Oppure potresti formattarlo nella sola intestazione e nella prima riga vuota sottostante predisponendo la macro affinché copy i dati tabellari originari riga per riga e che ad ogni operazione inserisca dopo l'ultima riga una nuova riga vuota (che assumerà automaticamente le caratteristiche di quella precedente) ...

Anche io la penso esattamento come te..e mi pare pure tutto semplice.. il problema è concretizzare la compilazione della macro.

[unlucky83]

Con il registratore di macro del mio Libreoffice ho registrato una macro con incolla speciale con flag su "Testo,Valori e Formattazioni"
In questo modo incolla "Testo,Valori e Formattazioni" e non le formule
Adatta alle tue esigenze

Codice: Seleziona tutto

REM  *****  BASIC  *****


sub Main
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$1:$C$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$H$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(5) as new com.sun.star.beans.PropertyValue
args4(0).Name = "Flags"
args4(0).Value = "SVT"
args4(1).Name = "FormulaCommand"
args4(1).Value = 0
args4(2).Name = "SkipEmptyCells"
args4(2).Value = false
args4(3).Name = "Transpose"
args4(3).Value = false
args4(4).Name = "AsLink"
args4(4).Value = false
args4(5).Name = "MoveMode"
args4(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())


end sub

La parte dei flag è

Codice: Seleziona tutto

args4(0).Name = "Flags"
La macro copia "$A$1:$C$3" e incolla in modo speciale in H1 dello stesso foglio

[Romio83]

Con il registratore di macro del mio Libreoffice ho registrato una macro con incolla speciale con flag su "Testo,Valori e Formattazioni"
In questo modo incolla "Testo,Valori e Formattazioni" e non le formule
Adatta alle tue esigenze

Codice: Seleziona tutto

REM  *****  BASIC  *****


sub Main
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$1:$C$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$H$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())

rem ----------------------------------------------------------------------
dim args4(5) as new com.sun.star.beans.PropertyValue
args4(0).Name = "Flags"
args4(0).Value = "SVT"
args4(1).Name = "FormulaCommand"
args4(1).Value = 0
args4(2).Name = "SkipEmptyCells"
args4(2).Value = false
args4(3).Name = "Transpose"
args4(3).Value = false
args4(4).Name = "AsLink"
args4(4).Value = false
args4(5).Name = "MoveMode"
args4(5).Value = 4

dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())


end sub

La parte dei flag è

Codice: Seleziona tutto

args4(0).Name = "Flags"
La macro copia "$A$1:$C$3" e incolla in modo speciale in H1 dello stesso foglio[/quote]
Grazie unlucky83, si è una strada che ho gia percorso ma non mi fa inserire i dati nel secondo file "archivio"che la macro dovrebbe generare in automantico.. questa compilazione "adattata" funziona solo per una copia dello stesso foglio nello stesso "file prova".. io vorrei che copiasse tutto in un secondo file.. non so per quale motivo non ci riesco.. :crazy: (mi ci vuole del tempo ma prima o poi la risolvo) è stano che non ci sia nessuno che si sia già imbattuto in questo problema.

[geovign]

Rielaborando le istruzioni suggerite da @unlucky83, il codice di seguito potrebbe essere un aiuto:

Codice: Seleziona tutto

sub Main
oDoc1 = ThisComponent
oDispatcher=createUnoService("com.sun.star.frame.DispatchHelper")
oFrame1=oDoc1.CurrentController.Frame
oSheet=oDoc1.Sheets(0)
rng=oSheet.getCellRangeByName("indicare.il.range.di.celle")  'ad esempio "A1:B2"
oDoc1.CurrentController.Select(rng)
oDispatcher.executeDispatch(oFrame1,".uno:Copy","",0,Array())
Dim Dummy()
oDoc2 = StarDesktop.loadComponentFromURL("private:factory/scalc" ,"_blank", 0, Dummy())
oDoc2.StoreAsURL(ConvertToUrl("percorso.completo.dove.salvare.il.file"),array())  'ad esempio C:\percorso\pippo.ods
rng=oDoc2.Sheets(0).getCellRangeByName("indicare.la.cella.di.partenza.della.copia") 'ad esempio "A1"
oDoc2.CurrentController.Select(rng)
oFrame2=oDoc2.CurrentController.Frame
Dim args1(5)as new com.sun.star.beans.PropertyValue
args1(0).Name="Flags"
args1(0).Value="SVDNT"
args1(1).Name="FormulaCommand"
args1(1).Value=0
args1(2).Name="SkipEmptyCells"
args1(2).Value=false
args1(3).Name="Transpose"
args1(3).Value=false
args1(4).Name="AsLink"
args1(4).Value=false
args1(5).Name="MoveMode"
args1(5).Value=4
oDispatcher.executeDispatch(oFrame2,".uno:InsertContents","",0,args1())
end sub

Il codice risolve il problema di copiare celle tra documenti diversi; al termine della copia resta da adattare la larghezza delle colonne.
Adatta alle tue esigenze.
Se ancora non l'hai ti consiglio di scaricarti la guida di Andrew Pitonyak qui, fonte di suggerimenti utili e sempre consigliata dal forum.
Saluti
Geo

[patel]

Rielaborando le istruzioni suggerite da @unlucky83, il codice di seguito potrebbe essere un aiuto:

NON potrebbe, è la soluzione

[lucky63]

NON potrebbe, è la soluzione

... chissà cosa penserà @Patel questa volta ...

--------------

Nell'esempio che allego il range A2:A4 contiene formattazioni particolari e formule.

La macro collegata al pulsante:

Codice: Seleziona tutto

Sub CopiaSoloDatiConImpostazioniDiFormattazione
Doc = ThisComponent
Foglio=Doc.Sheets(0) 'PrimoFoglio
RangeOrigine = Foglio.getCellRangeByName("A2:E4").RangeAddress
Destinazione = Foglio.getCellRangeByName("A10").CellAddress 'Cella iniziale in cui incollare
Foglio.CopyRange(Destinazione, RangeOrigine) 'Ricopia con formattazioni e formule
Foglio.getCellRangeByName("A10:E13").setDataArray(Foglio.getCellRangeByName("A10:E13").getDataArray) 'Ricopia solo dati su se stesso
End sub

- copia il range A2:A4 e lo incolla tale e quale (formule comprese) nello stesso foglio a partire da cella A10;
- copia il range incollato e lo incolla su se stesso (solo dati senza formule).
Risultato finale solo dati e formattazione come il range originario.

Adattando opportunamente la macro si ottiene lo stesso effetto/risultato su altro foglio dello stesso file o foglio di altro file esterno. Nel caso ci siano larghezze di colonna particolari dovranno essere adattate sul foglio di destinazione.
.

[geovign]

@Patel : grazie
@lucky63: l'istruzione CopyRange funziona solamente per copia all'interno dello stesso documento, se non sbaglio.
A questo punto conviene importare il foglio origine su nuovo documento e con CopyRange ricopiare su se stesso solo i dati.
O no?
Geo

[patel]

... chissà cosa penserà @Patel questa volta ...

che hai saltato la parte più difficile

[lucky63]

Avevo provato il CopyRange solo nello stesso foglio e anche verso altro foglio dello stesso file e funzionava.
Ho dato erroneamente per scontato che funzionasse anche verso altro file.

[patel]

prendendo spunto da tutti un'alternativa relativa al file iniziale potrebbe essere questa, ma mi sembra nigliore la soluzione di geovign

Codice: Seleziona tutto

Sub CopiaSoloDatiEFormattazione
Doc = ThisComponent
Sh1 = doc.Sheets(0)
oRange = Sh1.getCellRangeByName("A1:H17")
Doc.CurrentController.select(oRange)
o = Doc.CurrentController.getTransferable()
Dim Dummy()
Doc2 = StarDesktop.loadComponentFromURL("private:factory/scalc" ,"_blank", 0, Dummy())
sh2=Doc2.Sheets(0)
oRange = Sh2.getCellRangeByName("A1")
Doc2.CurrentController.select(oRange)
Doc2.CurrentController.insertTransferable(o)
sh2.getCellRangeByName("F3:H17").setDataArray(sh2.getCellRangeByName("F3:H17").getDataArray) 'Ricopia solo dati su se stesso
Sh2.getColumns().removeByIndex(0,5)
End sub

[lucky63]

Ottimo come sempre.
Già adattato il mio esempio precedente e ora funziona perfettamente anche trasferendo a nuovo file che a file specifico (Es.: file Archivio foglio Dati cella A10).
.

[geovign]

Scusate, ma oggi va così....

Codice: Seleziona tutto

Sub CopiaSoloDatiEFormattazione2
Doc = ThisComponent
UrlDoc = Doc.getUrl()
Sh1 = doc.Sheets(0)
Dim Dummy()
Doc2 = StarDesktop.loadComponentFromURL("private:factory/scalc" ,"_blank", 0, Dummy())
Sh2 = Doc2.Sheets(0)
rem copio foglio tra i due documenti con istruzione SheetLink (collegamento tra due fogli)
TipoCollegamento = com.sun.star.sheet.SheetLinkMode.NORMAL
rem ulterori parametri della istruzione SheetLink
DocOrigin = ""	'il file sorgente contiene un solo folgio quindi lascio il campo vuoto
DocFilter = ""
DocFilterOption = ""
rem creo il collegamento
Sh2.link(UrlDoc, DocOrigin, DocFilter, DocFilterOption, TipoCollegamento)
rem rimuovo il collegamento
Sh2.setLinkMode(com.sun.star.sheet.SheetLinkMode.NONE)
rem sovrascrivo l'intervallo di celle con i soli dati delle stesse celle
Sh2.getCellRangeByName("F1:H150").setDataArray(Sh1.getCellRangeByName("F1:H150").getDataArray)
rem elimino le colonne inutili
Sh2.getColumns.removeByIndex( 0, 5 )
...... poi salvare il nuovo documento 
End sub

L'intervallo di celle copiate è quello indicato nel file allegato al primo post di @Romio83.
Saluti
Geo

[patel]

Sempre meglio

[Romio83]

DocOrigin = "" 'il file sorgente contiene un solo folgio quindi lascio il campo vuoto
DocFilter = ""
DocFilterOption = ""
Geo

Grazie geovign, per questa soluzione, mi sono accorto che se sposto il foglio dalla prima posizione
foglio1 /foglio2 / foglio3
Nuovofoglio / foglio1 / foglio2 / foglio3
la macro copia nel file archivio i contenuti del foglio "nuovofile" in prima posizione appunto.. come posso indicare in modo univoco sempre lo stesso foglio in modo da aggiunderne altri o spostarlo senza problemi?

inoltre il file archivio ogni volta che lo apro mi chiede:
"l'aggiornamento automatico dei collegamenti è stato disattivato con il relativo pulsante (permetti)"
ho controllato il file archivio, ma non ho trovato nulla che lo potesse reindirizzare al file sorgente con qualche collegamento:crazy:

[geovign]

Il foglio da copiare (Sh1) è determinato in base all'indice e quindi viene sempre copiato il primo foglio indipendentemente dal nome. Per risolvere, puoi determinarlo in base al nome Sh1 = Doc.Sheets.getByName("Nomefoglio") - che già conosci.
Per il secondo problema, è la prima volta che mi capita ... proverò a capire dov'è l'inghippo.
Nel file allegato propongo una nuova soluzione; prima di eseguire la macro bisogna indicare, alla riga 40, il percorso completo del salvataggio (C:\percorso\nomefile.ods) .
Saluti
Geo

[Romio83]

Grazie infinite per la tua diponibiltà geovign cosi è perfetto.

[geovign]

Bene, grazie del riscontro.
Il secondo problema, avviso "aggiornamento automatico dei collegamenti...", è risolvibile sostituendo, nel codice indicato precedentemente,
TipoCollegamento = com.sun.star.sheet.SheetLinkMode.NORMAL
con
TipoCollegamento = com.sun.star.sheet.SheetLinkMode.VALUE
Con questa modifica vengono copiati solamente i dati e le formattazioni (non le formule), quindi non è più necessario ricopiare solo i dati su stesso.
Saluti.
Geo

[Romio83]

Buonasera a tutti riesumo questo vecchio post
Ho un problema con una macro

Copiavo solo i DATI e le FORMATTAZIONI dell’intervallo (F1:H150) in un nuovo documento senza FORMULE e ne VALIDA DATI presente nella colonna NOME, ma da quando ho dovuto inserire la password al foglio (“pippo” per sbloccarlo) non riesco più a copiare tutto in un nuovo file di copia dove non c’è bisogno della password. C’è soluzione?
Allego il file in questione contenente la macro..

[lucky63]

Nella macro ...
- all'inizio per rimuovere password pippo al foglio:

Codice: Seleziona tutto

ThisComponent.Sheets.GetByName("FoglioDaCopiareSenzaFormule").Unprotect("pippo")

- verso la fine per reinserire la password pippo al foglio:

Codice: Seleziona tutto

ThisComponent.Sheets.GetByName("FoglioDaCopiareSenzaFormule").Protect("pippo")

[Romio83]

Si ci avevo pensato.. ma non voglio dare la possibilità agli altri utenti di visualizzare la password del foglio.. per quello vorrei trovare una soluzione copiando solo i dati in un nuovo foglio

[lucky63]

Potresti crearti una tua nuova libreria di macro che può essere protetta con password e inserirci la macro.

Nello stesso file potresti utilizzare un foglio di appoggio uguale a quello protetto e trasferirvi dentro da stessa macro (o manualmente) il range dati di interesse e poi esportare il foglio di appoggio nel nuovo file.