Emanuele ha scritto:
L'output!
Nel caso sia numero, dipende dai settaggi di OO e da come è impostato
l'SO... e in ogni caso non mi sembra rappresenti un problema.
Se il SO è impostato in italiano (o per lo meno in modo che la virgola
sia il separatore decimali) no. ^_^
Per non aver problemi di questo genere sarebbe da modificare...e non so
di preciso come...
Non vorrei prendere l'ennesimo svarione... ma una volta che è convertito
in numero la sua visualizzazione dipende solo dai settaggi!
Per questo ipotizzavo il piano B, ovvero la form dove l'utente potesse
scrivere il ruolo di punti e virgole...
Sì, potrebbe essere un'idea.
Vediamo se ho capito.
All'inizio chiedi all'utente: "In questo foglio cosa ti aspetti sia il
separatore dei decimali?" Opzioni: punto e virgola.
Qualcosa del genere...
Dopo di che vai a controllare all'interno del foglio.
Continuiamo con l'esempio, mettiamo che hai scelto "punto", quindi se
trovi un numero tipo "5,555.44" lo converti in "5555,44" (perché la
virgola è il separatore di decimali del sistema).
Ora se trovi ad esempio "5.555,44" cosa fai?
Tu all'inizio hai detto che nel foglio ti aspetti che i decimali siano
separati con un punto, ma qui è il contrario: te ne freghi e "lo
converti" in numero lasciandolo com'è o lo tratti come un'errore perché
non è quello che ti aspettavi?
Se è stato stabilito che il range ha il punto come separatore decimale
inevitabilmente la stringa '5.555,44 e da mantenere come testo!
Sto solo cercando di capire per evitare di partire a spron battuto per
poi scoprire di aver capito il contrario. :-)
No no, hai capito bene! Ma non sono del tutto certo che l'idea sia
buona! :-)
Per questo vorrei ci riflettissi ancora un momento.. e vorrei anche
sentire l'opinione di Lido.
Ma credo che una variabile che contenga quell'informazione tu sappia
bene come utilizzarla...
Sai che non ne son tanto sicuro... ^_^
Io speravo di si! :-)
In realtà bisogna rinunciare a del sudato codice... e questo - mi rendo
conto - è seccante!
- eliminare gli spazi...
(Anzi qui mi dicevi che c'era un problema....)
Ciò che mi è venuti in mente è che se si eliminano gli spazi "a priori"
(su "Tipo2" per chi ha letto la sub), e poi questo risulta non essere
una stringa convertibile hai perso lo spazio che faceva parte
"dell'informazione".
Ovviamente in quel caso occorre recuperare la stringa originale!
La dove dici che Tipo2 = Cell.string si aggiunge
Tipo_0 = Tipo2 così si conserva la stringa originale per quell'uso.
(non so se l'hai capito, ma tendo ad essere molto
pignolo...)
La pignoleria in questi casi è cosa buona e giusta!
:-)
allego la tua macro "tal quale" con la sola aggiunta della inputbox...
ciao
Bart
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 13/06/06 CON LA SOLA AGGIUNTA DELLA MSGBOX E INPUTBOX
' 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 iContienePunti as integer
dim iContieneVirgole as integer
dim iContieneApici as integer
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()
IF msgbox (" Hai selezionate questo range... " & CHR$(10)_
& "Eseguo la conversione in numeri di queste celle?" & CHR$(10)_
& "(Il testo originale non verrà modificato) PROSEGUO?..." & ""
,36, "") = 6 then
InputVal = InputBox("I decimali sono definiti da virgole o
punti? ",_
"Scelta del simbolo usato per definire i
decimali", "VIRGOLA")
if InputVal = "VIRGOLA" then
InputVal = ","
else
InputVal = "."
end if
print InputVal
else
exit sub
end if
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
if not contieneTesto(Tipo2) then
Tipo2 = Trim(Tipo2)
Tipo2 = join(split(Tipo2, " "), "")
iContienePunti = contieneSimboli(Tipo2,
".")
iContieneVirgole =
contieneSimboli(Tipo2, ",")
iContieneApici = contieneSimboli(Tipo2,
"'")
if (iContienePunti > 0) and
(iContieneVirgole > 0) and (iContieneApici > 0) then
'Ci sono tutti e tre i simboli:
non so cosa fare...
errore_stringa(oMycell,Tipo2)
end if
if (iContienePunti > 0) and
(iContieneVirgole > 0) and (iContieneApici = 0) then
'Ci sono solo virgole e punti
if getPosLastSymbol(Tipo2, ",")
> getPosLastSymbol(Tipo2, ".") then
'l'ultima virgola sta
più a destra dell'ultimo punto
if iContieneVirgole > 1
then
'C'è più di una
virgola, non so cosa fare
Errore_Stringa(oMycell,Tipo2)
else
'C'è
una sola virgola copio la stringa
'Controllare la posizione
if
controllaPosizione(Tipo2, ",", ".") then
Copia_Stringa(oMycell,Tipo2)
else
Errore_Stringa(oMycell,Tipo2)
end if
end if
else
'l'ultima
virgola sta più a sinistra dell'ultimo punto
if
iContienePunti > 1 then
'C'è
più di un punto, non so cosa fare
Errore_Stringa(oMycell,Tipo2)
else
'C'è un solo punto copio la stringa
'Controllare la posizione
if controllaPosizione(Tipo2, ".", ",") then
Tipo2 = join(split(Tipo2, ","), "")
Tipo2 = join(split(Tipo2, "."), ",")
Copia_Stringa(oMycell,Tipo2)
else
Errore_Stringa(oMycell,Tipo2)
end if
end if
end if
end if
if (iContienePunti > 0) and
(iContieneVirgole = 0) and (iContieneApici > 0) then
'Ci sono solo punti ed apici
if getPosLastSymbol(Tipo2, ".")
> getPosLastSymbol(Tipo2, "'") then
'l'ultimo punto sta più
a destra dell'ultimo apice
'Controllare la
posizione
if
controllaPosizione(Tipo2, ".", "'") then
Tipo2 =
join(split(Tipo2, "."), ",")
Tipo2 =
join(split(Tipo2, "'"), "")
Copia_Stringa(oMycell,Tipo2)
else
Errore_Stringa(oMycell,Tipo2)
end if
else
'l'ultimo apice
sta più a destra dell'ultimo punto,
'non so cosa
fare...
Errore_Stringa(oMycell,Tipo2)
end if
end if
if (iContienePunti = 0) and
(iContieneVirgole > 0) and (iContieneApici > 0) then
'Ci sono solo virgole ed apici
if getPosLastSymbol(Tipo2, ",")
> getPosLastSymbol(Tipo2, "'") then
'l'ultima virgola sta
più a destra dell'ultimo apice
'Controllare la
posizione
if
controllaPosizione(Tipo2, ",", "'") then
Tipo2 =
join(split(Tipo2, "'"), "")
Copia_Stringa(oMycell,Tipo2)
else
Errore_Stringa(oMycell,Tipo2)
end if
else
'l'ultimo apice
sta più a destra dell'ultima virgola,
'non so cosa
fare...
Errore_Stringa(oMycell,Tipo2)
end if
end if
if (iContienePunti > 0) and
(iContieneVirgole = 0) and (iContieneApici = 0) then
'Ci sono solo punti
'Controllare la posizione
if iContienePunti > 1 then
'Ci sono molti punti
if
controllaPosizione(Tipo2, "", ".") then
Copia_Stringa(oMycell,Tipo2)
else
Errore_Stringa(oMycell,Tipo2)
end if
else
'C'è un solo
punto
if
controllaPosizione(Tipo2, "", ".") then
Tipo2 =
join(split(Tipo2, "."), "")
Copia_Stringa(oMycell,Tipo2)
else
if controllaPosizione(Tipo2, ".", "") then
Tipo2 = join(split(Tipo2, "."), ",")
Copia_Stringa(oMycell,Tipo2)
else
Errore_Stringa(oMycell,Tipo2)
end if
end if
end if
end if
if (iContienePunti = 0) and
(iContieneVirgole > 0) and (iContieneApici = 0) then
'Ci sono solo virgole
'Controllare la posizione
if iContieneVirgole > 1 then
'Ci sono molte virgole
if
controllaPosizione(Tipo2, "", ",") then
Tipo2 =
join(split(Tipo2, ","), "")
Copia_Stringa(oMycell,Tipo2)
else
Errore_Stringa(oMycell,Tipo2)
end if
else
'C'è una sola
virgola
if
controllaPosizione(Tipo2, ",", "") then
Copia_Stringa(oMycell,Tipo2)
else
if controllaPosizione(Tipo2, "", ",") then
Tipo2 = join(split(Tipo2, ","), "")
Copia_Stringa(oMycell,Tipo2)
else
Errore_Stringa(oMycell,Tipo2)
end if
end if
end if
end if
if (iContienePunti = 0) and
(iContieneVirgole = 0) and (iContieneApici > 0) then
'Ci sono solo apici
'Controllare la posizione
if controllaPosizione(Tipo2,
"", "'") then
Copia_Stringa(oMycell,Tipo2)
else
Errore_Stringa(oMycell,Tipo2)
end if
end if
if (iContienePunti = 0) and
(iContieneVirgole = 0) and (iContieneApici = 0) then
'apparentemente non c'è niente
che non vada, quindi la copiamo
Copia_Stringa(oMycell,Tipo2)
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
Function getPosLastSymbol(sText as string, sChar as string) as integer
dim lI as long
for lI = len(sText) to 0 step -1
if mid(sText, lI, 1) = sChar then
getPosLastSymbol = lI
exit function
end if
next lI
End Function
Function sequenzaMigliaia(sTesto as string, sExpDec as string, sExpMig as
string) as boolean
Dim iSimbPos as integer
if sExpDec = "" then
iSimbPos = len(sTesto) - 3
else
iSimbPos = len(sTesto) - 3 - (len(sTesto) -
InStr(sTesto, sExpDec)) - 1'len(sTesto) - 4
end if
do while (mid(sTesto, iSimbPos, 1) = sExpMig)
iSimbPos = iSimbPos - 4
if iSimbPos <= 0 then exit do
loop
if iSimbPos <= 0 then
sequenzaMigliaia = true
exit function
else
sequenzaMigliaia = false
exit function
end if
End Function
Function controllaPosizione(sTesto as string, sExpDec as string, sExpMig as
string) as boolean
' Dim iSimbPos as integer
' Dim bSembraOk as boolean
if sExpDec = "" and sExpMig = "" then
controllaPosizione = false
exit function
end if
if sExpDec = "" and not(sExpMig = "") then
controllaPosizione = sequenzaMigliaia(sTesto, sExpDec, sExpMig)
end if
if sExpMig = "" and not(sExpDec = "") then
if mid(sTesto, len(sTesto) - 3, 1) = sExpDec then
controllaPosizione = false
exit function
else
controllaPosizione = true
exit function
end if
end if
if not(sExpMig = "") and not(sExpDec = "") then
controllaPosizione = sequenzaMigliaia(sTesto, sExpDec,
sExpMig)' and bSembraOk)
end if
End Function
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(sTesto as string) as boolean
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 = ".[A-Za-zéèòàçìù%&]"
End With
oTextSearch.setOptions(aSrcOpt)
'L'asterisco serve come trucco per evitare che se il testo è il primo
carattere
'il aSearchResult.subRegExpressions sia comunque uguale a zero
aSearchResult = oTextSearch.searchForward("*" & sTesto, 0,Len(sTesto)+1)
if aSearchResult.subRegExpressions > 0 then
contieneTesto = true
end if
end function
function contieneSimboli(sTesto as string, sSimbolo as string) as integer
Dim sPaginaRiferimento as string
Dim iCount as integer
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
if sSimbolo = "." then
.searchString = "\" & sSimbolo 'sMigSep & ".*" &
sDecSep '"'\.[^ ]
else
.searchString = sSimbolo
end if
End With
oTextSearch.setOptions(aSrcOpt)
'L'asterisco serve come trucco per evitare che se il testo è il primo
carattere
'il aSearchResult.subRegExpressions sia comunque uguale a zero
aSearchResult = oTextSearch.searchForward("*" & sTesto, 0,Len(sTesto)+1)
if aSearchResult.subRegExpressions > 0 then
iCount = iCount + 1
end if
contieneSimboli = iCount
end function
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
