[Risolto] copiare solo Link collegamento ipertestuale

[marce84]

Ciao a tutti,
sto cercando di copiare da un elenco di collegamenti ipertestuali esclusivamente gli url.
Da questa precedente discussione (viewtopic.php?f=9&t=5929) ho trovato la macro che fa al caso mio e l'ho leggermente ritoccata ottenendo questo risultato:

Codice: Seleziona tutto

Sub hyperlinkcopy
   Dim oTextfields as Object, oTextfield as Object
   oDoc = ThisComponent
 ShM = oDoc.Sheets.GetByName("Medioevo")
   ShR = oDoc.Sheets.GetByName("Risultato")
   for r= 1 to 10000
     oLink = oDoc.createInstance("com.sun.star.text.TextField.URL") 
     oCell = ShR.getCellByPosition(0,r) 'target
     oCell1 = ShM.getCellByPosition(0,r) ' source
     oText = oCell.getText()
     oTextfields = oCell1.TextFields
     oLink.Representation=oTextFields.getByIndex(0).Url 
        oCell.insertTextContent(oText.createTextCursor(),oLink,True)   
   next
End Sub

la macro mi funziona esclusivamente se ci sono collegamenti ipertestuali per tutte le celle definite nell'intervallo (r = 1 to 10000) basta che anche sono una cella sia vuota e mi esce questo messaggio di errore che dovrebbe riguardare il getByIndex(0) della la penultima riga:

Codice: Seleziona tutto

Errore di runtime BASIC.
Si è verificata un'eccezione 
Type: com.sun.star.lang.IndexOutOfBoundsException
Message: .

ho provato ad inserire un if ma devo aver commesso qualche errore che mi rimanda sempre al messaggio di cui sopra.
Qualcuna ha qualche suggerimento.
Allego esempio
Grazie

[lucky63]

Prova così.

[marce84]

Ciao lucky63,
grazie per la soluzione, funziona benissimo, io avevo usato l'if in un posto che è meglio che non ti dico .
Per completare il tutto mi manca una sola cosa, nel mio file esistono delle celle che non hanno collegamenti ipertestuale nella stessa colonna pertanto ho provato a modificare il codice in modo che se il contenuto della cella è vuota o ha un testo mi copia la cella vuota o il testo altrimenti mi copia solo il collegamento ipertestuale.
Ahimè mi dà lo stesso errore, puoi aiutarmi ancora? Grazie.
Allego il tuo file da me modificato

[lucky63]

Prova adesso:

Codice: Seleziona tutto

Sub CopiaHyperLink_o_ContenutoCella
Rem Link quesito:
'https://forum.openoffice.org/it/forum/viewtopic.php?f=9&t=10076
Rem Link API service URL
'https://www.openoffice.org/api/docs/common/ref/com/sun/star/text/textfield/URL.html
Rem Definizione fogli di lavoro da utilizzare
Doc = ThisComponent
FoglioOrigine = Doc.Sheets.GetByName("Medioevo")
FoglioDestinazione = Doc.Sheets.GetByName("Risultato")

Rem Ultima riga dati del FoglioOrigine
Cursore = FoglioOrigine.createCursor
Cursore.gotoEndOfUsedArea(false)
UltimaRigaFO = Cursore.RangeAddress.EndRow

Rem Inizio Ciclo controllo dati
For riga = 1 to UltimaRigaFO
  Rem Primo carattere "formula" cella
  CellaOrigine = FoglioOrigine.GetCellByPosition(0,riga)
  FormulaCellaOrigine = CellaOrigine.formula
  PrimoCarattere = left(FormulaCellaOrigine,1)

  REM Verifica primo carattere
  If PrimoCarattere <> "'" then
    Rem Trascrivi contenuto cella
    FoglioDestinazione.GetCellByPosition(0,riga).String = CellaOrigine.String
  Else
    Rem Trascrivi l'HiperLink della cella
    Link = Doc.createInstance("com.sun.star.text.TextField.URL") 
    CellaDestinazione = FoglioDestinazione.getCellByPosition(0,riga)
    Testo = CellaDestinazione.getText()
    CampoTesto = CellaOrigine.TextFields
    Link.Representation=CampoTesto.getByIndex(0).Url ' indirizzo
    CellaDestinazione.insertTextContent(Testo.createTextCursor(),Link,True)   
  End If
Next riga

End sub

Testato e funzionante sul file che allego.

[marce84]

ho visto la tua soluzione ero talmente entusiasta che ho cantato vittoria troppo presto.
Nel file che ho allegato come esempio ho inserito solo collegamenti ipertestuali il cui nome è un numero, in realtà ho altri collegamenti ipertestuali il cui nome è alfanumerico o composto solo da caratteri. Riesci a modificare la bella macro che hai fatto in modo che consideri numeri, caratteri e caratteri alfanumerici ?
Grazie

[lucky63]

Ho cambiato un po'.
Provata mi sembra ok.
Fai sapere.

[marce84]

Ciao Lucky63,
ho testato la tua macro con tutti i caratteri alfanumerici e non, punti, virgole trattini e quant'altro ho nel mio database ......e funziona tutto alla grande.
Grazie mille e complimenti per la preparazione. Sei un grande