Sono stato via due giorni e voi intanto avete poltrito... :-)
MA devo proprio fare tutto da me? :-)
HAA! ho capito... eravate impegnati ad annullare le "ricevute di
ritorno"... allora vi perdono! :-)
Intanto ho pensato a come rigenerare la macro degenerata... :-)
Probabilmente il tutto può essere ricondotto sole due situazioni:
1) la macro riconosce un numero, oppure riesce a convertire una stringa
in un numero
2) la macro trova una stringa nella quale non riesce a riconoscere un
numero in tal caso duplica la stringa e la segna in rosso.
Allo stato attuale del codice direi che la situazione 1 copre ormai
buona parte dei casi che si possono incontrare... o meglio tutti i casi
che ho realmente incontrato sono stati correttamente interpretati e
correttamente convertiti.
Il caso ambiguo citato nei commenti ( 55'4444 ) darebbe del filo da
torcere ad avvocati, CTP e CTU... figuriamoci ad una macchina!
Se fosse possibile riconoscerlo e NON covertirlo (ma solo copiarlo come
stringa) sarebbe la soluzione ottimale.... ma non vedo come...
Poi, ripeto, io non ho ancora incontrato casi del genere...
Ricadono invece nel caso 2 tutte le stringhe vere... cioè le parole e le
frasi che - in ogni caso - non devono essere convertite.
Fa eccezione il caso di '$ 3.200, '€ 345,34, etc ... ovvero le
situazioni dove ai numeri (in formato testo) è rimasto appiccicato il
segno di valuta.
Questi casi sono facilmente risolvibili con un cerca/sostituisci... ma
se nel range abbiamo più valute diverse potrebbe diventare complicato.
Ritenete si debba ancora pensare a convertirli? Oppure ci fermiamo qui?
Per l'Addon... cosa facciamo?
Qualcuno pensa sia utile?
Oppure si "pubblica" la macro sul wiki e ci scordiamo della cosa...
(...almeno fino a quando qualcuno scopre un caso generalizzato di
malformattazione...8-) )
In ogni caso io ho pasticciato l'ultima versione di Emanuele con qualche
modifica discutibile.
Adesso funziona come dicevo sopra.
Ho anche aggiunto una progressbar e una msgbox quando termina... (su
range di migliaia di celle metteva ansia...)
Rimane da risolvere l'avvio... nel senso che l'utente, prima di azionare
la macro, deve selezionare il range di celle... e di questo - forse -
dovrebbe esserne informato...
fatemi sapere
Bart
(io intanto l'inserisco nell'aggiornamento di Ultimus)
REM ***** BASIC *****
Sub Che_Digerisce_Quasi_Tutto_e_Lo_Converte_In_Numeri()
' Converte da numeri in formato stringa
' a nuneri "veri"
' copiandoli su una nuova colonna a lato
' versione del 07/06/06
' da azionare dopo aver selezionato
' il range di celle da convertire
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")
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)
Dim oBarra As Object
oBarra = _
thisComponent.GetCurrentController.GetFrame.CreateStatusIndicator '''
oBarra.Start(" Inizio la Conversione", Val(f))
For g = Val(e) to Val(f) ' Inizia il ciclo
oBarra.setValue(g)'''
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
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
' Questa va fatta in caso di bisogno
End Select
Next
oBarra.End
msgbox " La conversione in numeri è "_
& "terminata... "& CHR$(10) & CHR$(10)_
& "Le eventuali stringhe che non sono riuscito "_
& "ad interpretare le ho copiate tali e quali, "_
& "ma ""segnandole"" con sfondo in rosso! "_
& "( molto rosso... :-) )"
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,0,0)
'end if
End Sub
Sub Copia_Stringa(oMycell,Tipo2)
on error goto gest_errore
oMycell.setValue(cDbl(Tipo2))
oMycell.NumberFormat = 4
exit sub
gest_errore:
' lo so che è una porcata...
oMycell.setString(Tipo2)
oMycell.CellBackColor = RGB(255,0,0)
'
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]
