Apache OpenOffice: forum della comunità

Qualche giorno fa grazie alla collaborazione di lucky63 ho risolto il problema di inserire dati in un determinato file anche se questo file di destinazione si trova sul desktop di computer con nomi diversi (quindi rileva automaticamente il percorso da attribuire al file). Adesso mi è sorta l'esigenza di inviare dati sempre a computer diversi ma il file di destinazione non ha più lo stesso nome uguale per tutti (come era prima) bensì lo prende dalla cella B48 del file di origine in modo tale da avere, anzichè un archivio dati unico, tanti piccoli archivi personalizzati quante sono le persone che inviano questi dati (10/15 circa). In pratica ognuno avrà un file con il proprio nome e cognome. Avevo pensato di definire NomeFile = B48 ed inserirlo nel percorso UrlSenzaNomeFile & B48 ma non funziona. Avrei bisogno ancora dei vostri suggerimenti. Posto qui di seguito la macro che vorrei modificare. Grazie mille.

Codice: Seleziona tutto

Sub CopiaRange
Dim DocName as object, DocUlr as string, dummy(), range as object
Doc = ThisComponent
REM ===========================================================
Rem Acquisisco URL completo relativo a QUALSIASI PC da cui venga avviato il file
Url = Doc.GetUrl()

REM Trovo la posizione dell'ultima / all'interno della stringa dell'URL acquisito automaticamente.
For X = Len(Url) To 1 Step -1
If InStr(X , Url , "/") <> 0 Then
PosizioneUltimaBarra = X
X = 0
End If
Next
UrlSenzaNomeFile = Left(url , PosizioneUltimaBarra)
'MsgBox (UrlSenzaNomeFile , 0 , "URL senza il nome del file") 'Verifica OK
REM ===========================================================

Sheet = Doc.Sheets(0)
Range1 = Sheet.getCellRangeByName("A48:E48").getDataArray ' range da copiare
Dim Args(0) As New com.sun.star.beans.PropertyValue
Args(0).Name = "MacroExecutionMode"
Args(0).Value = com.sun.star.document.MacroExecMode.ALWAYS_EXECUTE_NO_WARN
' DocUrl = ConvertToURL(sFileName)
DocUrl = UrlSenzaNomeFile & "NomeDelFileDell'ArchivoEsterno.ods" ' Url completo del file di destinazione
REM ===========================================================

DocName = StarDesktop.loadComponentFromURL (DocUrl, "_blank",0, Args() )
NomeFile = DocName.Sheets(2)

dRange1 = NomeFile.getCellRangeByName("A48:E48") ' range destinazione
dRange1.setDataArray(Range1)

DocName.store()
Doc.Close(true)

End Sub

per programmare occorre studiare e lo puoi fare qui http://www.pitonyak.org/oo.php
Posso capire di avere problemi per copiare un range su un altro file, ma leggere il contenuto di una cella devi riuscire a farlo studiando.

.
Notare le modifiche tra i due REM .

Codice: Seleziona tutto

REM ===========================================================
Sheet = Doc.Sheets(0)
CellaB48 = Sheet.getCellRangeByName("B48").String
Range1 = Sheet.getCellRangeByName("A48:E48").getDataArray ' range da copiare
Dim Args(0) As New com.sun.star.beans.PropertyValue
Args(0).Name = "MacroExecutionMode"
Args(0).Value = com.sun.star.document.MacroExecMode.ALWAYS_EXECUTE_NO_WARN
DocUrl = UrlSenzaNomeFile & CellaB48 & ".ods" ' Url completo del file di destinazione
REM ===========================================================

Ringrazio sia patel per la "strigliata" che sicuramente meritavo (purtroppo in questo momento ho poco tempo perchè ho una ristrutturazione di casa in corso) sia lucky63 per il suggerimento. Ieri sera, combattendo con il sonno, sono riuscito a fare aprire il file con il nome preso dalla cella B48 del file di origine. Però il problema è che non mi incolonna i dati in quanto, sicuramente, avrò fatto confusione nelle definizioni iniziali. Posto qui la macro che ho modificato ieri sera, scusandomi anticipatamente per gli strafalcioni che troverete, ma avevo troppo sonno.... Grazie mille per gli eventuali suggerimenti con la solenne promessa a patel che studierò a fondo tutta la guida di Pitonyack. Buona giornata a tutti.

Dim DocName as object, DocUlr as string, dummy(), range as object, Nome as string, FileName as string
Doc = ThisComponent
Url = Doc.GetUrl()
For X = Len(Url) To 1 Step -1
If InStr(X , Url , "/") <> 0 Then
PosizioneUltimaBarra = X
X = 0
End If
Next
UrlSenzaNomeFile = Left(url , PosizioneUltimaBarra)
Sheet = Doc.Sheets(0) ' 1° foglio del file contenete la macro
Range = Sheet.getCellRangeByName("A48:E48").getDataArray ' range da copiare
Nome = Sheet.getCellRangeByName("B48").string
FileName = UrlSenzaNomeFile & Nome & ".ods" ' file destinazione
DocUrl = ConvertToURL(FileName)
DocName = StarDesktop.loadComponentFromURL (DocUrl, "_blank",0, Dummy() )
Nome = DocName.Sheets(0)
Cursore = DocName.createCursor
Cursore.gotoEndOfUsedArea(false)
UltimaRiga = Cursore.RangeAddress.EndRow
Riga = UltimaRiga + 2
dRange = DocName.getCellRangeByName("A" & Riga & ":E" & Riga) ' range destinazione (PrimaRigaLibera)
dRange.setDataArray(Range)
DocName.store
DocName.Close(true)

End Sub

Ciao, sei pregato di formattare il codice che inserisci nei messaggi, grazie

lucky63 ha scritto:.
Notare le modifiche tra i due REM .

Codice: Seleziona tutto

REM ===========================================================
Sheet = Doc.Sheets(0)
CellaB48 = Sheet.getCellRangeByName("B48").String
Range1 = Sheet.getCellRangeByName("A48:E48").getDataArray ' range da copiare
Dim Args(0) As New com.sun.star.beans.PropertyValue
Args(0).Name = "MacroExecutionMode"
Args(0).Value = com.sun.star.document.MacroExecMode.ALWAYS_EXECUTE_NO_WARN
DocUrl = UrlSenzaNomeFile & CellaB48 & ".ods" ' Url completo del file di destinazione
REM ===========================================================

Invio, qui di seguito, la mail modificata. Adesso funziona bene solo che lascia la prima riga vuota e, se metto la griglia dei bordi per delimitare righe e colonne, incomincia a scrivere nell'ultima riga quando terminano i bordi. Sinceramente non ne capisco il motivo. Se hai qualche suggerimento per modificare la macro te ne sarei molto grato. Grazie mille

Dim DocName as object, DocUlr as string, dummy(), range as object, CellaB48 as string, FileName as string, Nome as object
Doc = ThisComponent
Url = Doc.GetUrl()
For X = Len(Url) To 1 Step -1
If InStr(X , Url , "/") <> 0 Then
PosizioneUltimaBarra = X
X = 0
End If
Next
UrlSenzaNomeFile = Left(url , PosizioneUltimaBarra)
Sheet = Doc.Sheets(0) ' 1° foglio del file contenete la macro
Range = Sheet.getCellRangeByName("A48:E48").getDataArray ' range da copiare
CellaB48 = Sheet.getCellRangeByName("B48").String
FileName = UrlSenzaNomeFile & CellaB48 & ".ods" ' file destinazione
DocUrl = ConvertToURL(FileName)
DocName = StarDesktop.loadComponentFromURL (DocUrl, "_blank",0, Dummy() )
Nome = DocName.Sheets(0)
Cursore = Nome.createCursor
Cursore.gotoEndOfUsedArea(false)
UltimaRiga = Cursore.RangeAddress.EndRow
Riga = UltimaRiga + 2
dRange = Nome.getCellRangeByName("A" & Riga & ":E" & Riga) ' range destinazione (PrimaRigaLibera)
dRange.setDataArray(Range)
DocName.store
DocName.Close(true)

End Sub

...
viewtopic.php?f=9&t=10673#p60280

charlie ha scritto:Ciao, sei pregato di formattare il codice che inserisci nei messaggi, grazie

Mi dispiace di non averlo fatto ma credo di non averlo mai fatto e quindi non so se bisogna cliccare su Code, List o altro. Dove posso vedere come si formatta il codice macro? Grazie

Code. Se vuoi riformattare il codice che hai scritto, puoi modificare i tuoi messaggi

Grazie mille.

Apache OpenOffice: forum della comunità

[Risolto]Copia dati su file esterno con nome da una cella

[Risolto]Copia dati su file esterno con nome da una cella

Re: Copia dati su file esterno con nome da una cella

Re: Copia dati su file esterno con nome da una cella

Re: Copia dati su file esterno con nome da una cella

Re: Copia dati su file esterno con nome da una cella

Re: Copia dati su file esterno con nome da una cella

Re: Copia dati su file esterno con nome da una cella

Re: Copia dati su file esterno con nome da una cella

Re: [Risolto]Copia dati su file esterno con nome da una cell

Re: [Risolto]Copia dati su file esterno con nome da una cell