Tempo fa Paolo aveva postato una soluzione per acchiappare un range
selezionato con il mouse...
Emanuele aveva "interpretato" e ne era venuto fuori un bell'aggeggio che
io ho riutilizzato in diverse occasioni.
(Quando parla Paolo ho bisogno dell'interprete...:-) )
L'unico difetto/limite era che la rotelle del mouse era inibita... poi è
sbucata una faccenda fastidiosa che cercherò di descrivere.
Apri nuovo doc calc (chiamiamolo doc1)
Infilarci dentro (nell'IDE intendo) il codice che posto in coda alla mail
Crea un pulsante su una sheet di doc1 e collegalo alla macro
copia_solo_colore_Sfondo
Apri un nuovo doc calc (chiamiamolo doc2)
Cerca & sostituisci e cerca una stringa qualsiasi...
lascia la finestra della ricerca aperta... e
seleziona doc1
colora una cella con un colore a piacere...
seleziona la cella colorata e
aziona il pulsante (macro > copia_solo_colore_sfondo....)
Seleziona un range...
La macro dovrebbe concludere con successo colorando a puntino il range
selezionato...
Ma qui succede l'evento: doc2 passa in primo piano...
(o sarebbe meglio dire che doc1 è passa in secondo piano?)
La linguetta (in basso) attiva è sempre quella di doc1, ma quella che si
vede è doc2...
Questo succede QUASI sempre!
Ed è molto fastidioso...
C'è modo di porci rimedio?
E per la rotella inibita... si può fare qualcosa?
grazie per le risposte
Bart
----------------------------------------------
Questo è il codice... spero di non aver dimenticato nulla...
REM ***** BASIC *****
Global oRangeSelectionListener As Object
Global sA as string
SUB Copia_solo_colore_Sfondo '
Dim oSheetSRC as object
Dim oSheetDest as object
Dim oRangeDest as object
Dim oCellSRC as object
Dim lSheetDest as long
Dim lcolorSRC as long
oSheetSRC = ThisComponent.Sheets.getByName(_
ThisComponent.currentcontroller.activesheet.name)
oCellSRC=ThisComponent.getCurrentSelection()
lcolorSRC = oCellSRC.Cellbackcolor
SelectedRange = getRange() ' richiama il listeners
' che restuisce un address come stringa
lSheetDest= getSheet(SelectedRange)
'numero della sheet (anche un'altra da SRC)
oSheetDest = ThisComponent.Sheets.getByIndex(lSheetDest)
' oggetto sheet
oRangeDest = oSheetDest.getCellRangeByName(SelectedRange)
' oggetto range di destinazione
oRangeDest.Cellbackcolor = lcolorSRC
end sub
function getRange() as string
sA = ""
TestRangeSelection
do
wait 100
loop while sA = ""
getRange = sA
end function
Sub TestRangeSelection()
oDocView = ThisComponent.currentController
If Not IsNull(oRangeSelectionListener) Then
oDocView.removeRangeSelectionListener(_
oRangeSelectionListener)
End If
oRangeSelectionListener = createUnoListener("oDocView_" , _
"com.sun.star.sheet.XRangeSelectionListener")
oDocView.addRangeSelectionListener (_
oRangeSelectionListener)
Dim mArgs(2) As New com.sun.star.beans.PropertyValue
mArgs(0).Name = "InitialValue"
mArgs(0).Value = "A1"
mArgs(1).Name = "Title"
mArgs(1).Value = "Click sulla destinazione........."
mArgs(2).Name = "CloseOnMouseRelease"
mArgs(2).Value = True
oDocView.startRangeSelection(mArgs())
End Sub
function getSheet(ByVal sAddress as string) as string
' dim cellRange as object
dim currentSheet as object
' dim row as object
currentSheet =_
ThisComponent.CurrentSelection.getSpreadSheet()
cellRange = currentSheet.getCellRangeByName(sAddress)
' row = cellRange.getRows()
getSheet = cellRange.RangeAddress.sheet
end function
sub oDocView_done(oEvent)
'questa routine viene chiamata dal documento
'dopo che l'utente ha finito di selezionare il range
sA = oEvent.RangeDescriptor
oEvent.source.removeRangeSelectionListener(_
oRangeSelectionListener)
End Sub
sub oDocView_aborted(oEvent)
'questa routine viene chiamata dal documento
'se l'utente non ha selezionato nessun range
oEvent.source.removeRangeSelectionListener(_
oRangeSelectionListener)
End Sub
sub oDocView_disposing(oEvent)
'questa routine viene chiamata dal documento
'in caso di dipartita del compianto listener
End Sub
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
