>>> ( Altre due proprietà della cella a titolo informativo
>>> com.sun.star.table.CellContentType.EMPTY
>>> com.sun.star.table.CellContentType.FORMULA )
>>>
Bella questa soluzione, non la conoscevo.
>> Ancora "Ottimo" !!! :-), ma sono riuscito ad incepparla su una stringa
>> mista sul tipo:
>> "Pippo ha 1350,00 €"
>> ...ovvero un testo che contiene quei caratteri dà
>> errore...
>>
Certo che se ti aspetti listini di questo genere faresti prima a tenere
corsi per insegnare come compilarli!!! :-))
> Il problema è che se c' è un punto o una virgola dove potrebbe averli
> un numero reale il codice lo tratta come tale anche se gli altri caratteri
> sono lettere, di conseguenza lo copia e cerca di formattarlo come un
> numero, da qui l' errore
>
Beh, d'altronde ormai la sub sta un po' degenerando...
Era partita con un obiettivo ed ad ogni round si è aggiunto
qualcosa...tranne quando ho chiesto quali erano i casi possibili... ;-(
> Ho aggiunto un ciclo for next per testare se nella stringa ci sono caratteri
> dalla a alla z,
Solo una piccola ottimizzazione/suggerimento: non è necessario testare
sempre tutto, se esiste anche un solo carattere è sufficiente, esempio:
dim v as boolean
for z = 65 to 90
if InStr(lcase(Tipo2) , Chr(z)) > 0 then
v = true
exit for
end if
next z
e più sotto:
if v Then
In questo caso specifico, però, io suggerirei di utilizzare la funzione
di ricerca:
aSearchResult = oTextSearch.searchForward(Tipo2, 0,Len(Tipo2))
if aSearchResult.subRegExpressions = 0 then
Nella sub sotto è già inserita.
Non è assolutamente farina del mio sacco, ma di quello di Paolo (e chi
altrimenti? :-) ) l'ho presa da:
http://codesnippets.services.openoffice.org/Office/Office.SimpleNaturalSortAlgorithm.snip
Purtroppo, non son riuscito a farla funzionare con apici, punti e
virgole, altrimenti risolveva tutti i problemi...o almeno buona parte!
Ho aggiunto anche altri due commenti nel codice.
Ciao!
Emanuele.
REM ***** BASIC *****
option explicit
Sub Che_Digerisce_Quasi_Tutto_e_Lo_Converte_In_Numeri()
' versione del 02/06/06
' da azionare con range pre-selezionato
' modificata con inserimento colonna
'on error goto errore_stringa
Dim d As long
Dim e As long
Dim f As long
Dim g As long
Dim Tipo As Double
Dim Tipo2 As String
dim oFoglio As Object
dim oSelections as object
Dim oMycell As Object
Dim oMyRange As Object
Dim NumCol As Integer
dim cell as object
Dim h As Integer
Dim i As Integer
Dim l As String
Dim iPosizionePrimoPunto as integer
Dim iPosizionePrimaVirgola as integer
dim sPaginaRiferimento as string
dim oTextSearch as object
dim aSearchResult as object
Dim aSrcOpt As New com.sun.star.util.SearchOptions
oTextSearch = CreateUnoService("com.sun.star.util.TextSearch")
With aSrcOpt
.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED
.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
.searchString = lCase(".[A-Za-zéèòàçìù]")
End With
oTextSearch.setOptions(aSrcOpt)
Set oFoglio =
ThisComponent.Sheets.getByName(ThisComponent.currentcontroller.activesheet.name)
oSelections = ThisComponent.getCurrentSelection()
oMyRange=oSelections.getRangeAddress()
d = oMyRange.StartColumn 'getColonnaIniziale(a)
e = oMyRange.StartRow 'getRigaIniziale(a)
f = oMyRange.EndRow 'getRigaFinale(a)
NumCol = oMyRange.StartColumn ' definisce il numero della colonna
oFoglio.Columns.insertbyindex(d+1,1)
For g = Val(e) to Val(f) ' Inizia il ciclo
Cell = oFoglio.getCellByPosition(NumCol, g)
oMycell = oFoglio.getCellByPosition(NumCol+1, g )
Select Case Cell.Type
Case com.sun.star.table.CellContentType.VALUE
' Se è un valore si limita a copiarlo e formattare la cella
Tipo = Cell.Value
oMycell.setValue(Tipo)
oMycell.NumberFormat = 4 'Valore ##.##0,00
Case com.sun.star.table.CellContentType.TEXT
' Se è di tipo testo fa una serie di controlli per determinare
' che tipo di stringa è
' se trova dei caratteri di testo o delle celle vuote
' salta alla cella dopo
Tipo2 = Cell.String
aSearchResult = oTextSearch.searchForward(Tipo2, 0,Len(Tipo2))
if aSearchResult.subRegExpressions = 0 then
'*****NUOVO COMMENTO*****
'Se vogliamo fare i pignoli, in questa posizione
'mancano dei controlli su dove si trova l'apice.
'Se ad esempio abbiamo un numero come: 55'4444
'è un 554'444 con un certo errore di battitura,
'oppure è un 55'444,4 con un altro errore di battitura?
'I casi sono molti e come ha detto Paolo non sempre è
'possibile trovare una soluzione generica...
'Ed il bello è che lo stesso discorso si può fare in
'altri punti del codice...
if InStr(Tipo2, "'") > 0 then
Tipo2 = join(split(Tipo2,"'"),"")
Tipo2 = Trim(Tipo2)
end if
iPosizionePrimoPunto = InStr(Tipo2, ".")
iPosizionePrimaVirgola = InStr(Tipo2, ",")
if (iPosizionePrimoPunto = 0 and iPosizionePrimaVirgola = 0) then
'*****NUOVO COMMENTO*****
'Non ci sono virgole,
'non ci sono punti,
'non ci sono apici,
'non ci sono lettere,
'cosa è rimasto?
'Se non rimane altro qui
'dovrebbero esserci solo numeri...
'errore_stringa(oMycell,Tipo2)
Copia_Stringa(oMycell,Tipo2)
else
if iPosizionePrimoPunto = 0 then
'Ci sono solo virgole
if InStr(iPosizionePrimaVirgola + 1, Tipo2) > 0 then
'C'è più di una virgola, allora sarà
'un separatore di migliaia
'Lo rimuovo
Tipo2 = join(split(Tipo2, ","), "")
Copia_Stringa(oMycell,Tipo2)
else
'C'è solo una virgola
if (((len(Tipo2) - iPosizionePrimaVirgola) < 3)or _
((len(Tipo2) - iPosizionePrimaVirgola) > 4))then
'La virgola ha meno di due o più di 4 alla
'sua destra, allora è quasi certamente
'un separatore di decimali
'Quindi non facciamo niente
Copia_Stringa(oMycell,Tipo2)
else
'La virgola ha esattamente 3
'cifre alla sua
'destra, può essere un separatore di
'decimali, ma anche un
'separatore di migliaia,
'non posso decidere cosa fare...
errore_stringa(oMycell,Tipo2)
end if
end if
end if
if iPosizionePrimaVirgola = 0 then
if InStr(iPosizionePrimoPunto + 1, Tipo2) > 0 then
'C'è più di un punto, allora sarà un
'separatore di migliaia
'Lo rimuovo
Tipo2 = join(split(Tipo2, "."), "")
Copia_Stringa(oMycell,Tipo2)
else
'C'è un solo punto
if (((len(Tipo2) - iPosizionePrimoPunto)< 3) or _
((len(Tipo2) - iPosizionePrimoPunto)> 4)) then
'Il punto ha meno di due o più di 4
'alla sua destra,
'allora è quasi certamente
'un separatore di decimali
'Allora sostituiamo il punto con una
'virgola
Tipo2 = join(split(Tipo2, "."), ",")
Copia_Stringa(oMycell,Tipo2)
else
'Il punto ha esattamente 3 cifre
'alla sua destra, può
'essere un separatore di
'decimali, ma anche un
'separatore di migliaia, non
'posso decidere cosa fare...
errore_stringa(oMycell,Tipo2)
end if
end if
end if
if ((iPosizionePrimoPunto > iPosizionePrimaVirgola) and _
(iPosizionePrimaVirgola > 0)) then
'Ragionevolmente il punto sarà il separatore dei decimali
'Togliamo le virgole come separatore delle migliaia
Tipo2 = join(split(Tipo2, ","),"")
'Sostituiamo il punto con la virgola come separatore dei decimali
Tipo2 = join(split(Tipo2, "."),",")
Copia_Stringa(oMycell,Tipo2)
end if
if ((iPosizionePrimoPunto < iPosizionePrimaVirgola) and _
(iPosizionePrimoPunto > 0)) then
'Ragionevolmente la virgola sarà il separatore dei decimali
'Togliamo i punto come separatori delle migliaia
Tipo2 = join(split(Tipo2, "."),"")
'E la virgola la lasciamo alsuo posto
Copia_Stringa(oMycell,Tipo2)
end if
end if
else
errore_stringa(oMycell, Tipo2)
end if
Case com.sun.star.table.CellContentType.EMPTY
MsgBox(" Dice la particella di sodio "_
& CHR$(10) & CHR$(10) & " CA NON CI STA NISCIUNO!")
Case com.sun.star.table.CellContentType.FORMULA
' Quuesta va fatta in caso di bisogno
End Select
Next
end sub
Sub errore_stringa(oMycell, Tipo2)
If MsgBox("Non riesco ad interpretare "& "questa stringa...--> "& _
"' " & Tipo2 & " '" & CHR$(10) & _
" Proseguo copiando il testo tal quale ?" & "" ,36, "") = 6 then
oMycell.setString(Tipo2)
oMycell.CellBackColor = RGB(255,100,100)
end if
End Sub
Sub Copia_Stringa(oMycell,Tipo2)
oMycell.setValue(cDbl(Tipo2))
oMycell.NumberFormat = 4
End Sub
function contieneTesto(byRef sTesto as string) as boolean
dim sPaginaRiferimento as string
dim oTextSearch as object
Dim aSrcOpt As New com.sun.star.util.SearchOptions
oTextSearch = CreateUnoService("com.sun.star.util.TextSearch")
With aSrcOpt
.searchFlag = com.sun.star.util.SearchFlags.REG_EXTENDED
.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
.searchString = lCase(".[A-Za-zéèòàçìù]")
End With
oTextSearch.setOptions(aSrcOpt)
aSearchResult = oTextSearch.searchForward(sTesto, 0,Len(sTesto) )
if aSearchResult.subRegExpressions > 0 then
v = true
end if
end function
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
