Bart prova con questa soluzione, è un po' più generica, ma non è completa.
Come non detto, c'era un errore (ed anche grosso!!!), questa funziona
sicuramente sui seguenti casi:
34
'33.4
'32.3
'33.223.44,33
233,333,333
Su altri non ho provato...
Ciao!
Emanuele.
REM ***** BASIC*****
REM MODULO 1
option explicit
Sub Che_Digerisce_Quasi_Tutto_e_Lo_Converte_In_Numeri()
Dim a As String
Dim b As String
Dim c As String
Dim d AS String
Dim e As String
Dim f As String
Dim g As Integer
Dim Tipo As Double
Dim Tipo2 As String
dim oFoglio As Object
Dim oMycell As Object
Dim oMyRange As Object
Dim NumCol As Integer
Set oFoglio = ThisComponent.Sheets.GetByName("Sheet1")'Il nome va
cambiato con il nome del foglio
'd = InputBox("Immettere la lettera della Colonna da convertire (es.
A)","Immissione dati")
'e = InputBox("Immettere il numero della riga che inizia la colonna (es.
4)","Immissione dati")
'f = InputBox("Immettere il numero della riga che Finisce la colonna
(es. 35)","Immissione dati")
'Questa serie di input per poter determinare il range da convertire
'a = d + e + ":" + d + f
a = getRange()
d = getColonna(a)
e = getRigaIniziale(a)
f = getRigaFinale(a)
oMyRange = oFoglio.getCellRangeByName(a).getRangeAddress()
NumCol = oMyRange.StartColumn ' definisce il numero della colonna
For g = Val(e) to Val(f) ' Inizia il ciclo
Tipo = oFoglio.getCellByPosition(NumCol, g - 1).Value
Tipo2 = oFoglio.getCellByPosition(NumCol, g - 1).String
if Tipo <> 0 Then ' Se è un numero si limita a formattare
'la cella
oMycell = oFoglio.getCellRangeByName(d + LTrim(Str(g)))
oMycell.NumberFormat = 4 'Valore ##.##0,00
Else ' Altrimenti 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
Dim iPosizionePrimoPunto as integer
Dim iPosizionePrimaVirgola as integer
iPosizionePrimoPunto = InStr(Tipo2, ".")
iPosizionePrimaVirgola = InStr(Tipo2, ",")
if (iPosizionePrimoPunto = 0 and iPosizionePrimaVirgola = 0)
then
'Non ci sono nè virgole nè punti
'Potrebbe contenere del testo
'Ci sono varie cose da fare...
else
if iPosizionePrimoPunto = 0 then
'Ci sono solo virgole
msgbox InStr(iPosizionePrimaVirgola + 1, Tipo2, ",")
if InStr(iPosizionePrimaVirgola + 1, Tipo2, ",")
> 0 then
'C'è più di una virgola, allora sarà un
separatore di migliaia
'Lo rimuovo
Tipo2 = join(split(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
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...
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, "."), "")
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, "."), ",")
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...
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, "."),",")
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
end if
end if
oFoglio.getCellByPosition(NumCol, g - 1).setValue(cDbl(Tipo2))
oMycell = oFoglio.getCellRangeByName(d + LTrim(Str(g)))
oMycell.NumberFormat = 4
end if
Next
end sub
function getColonna(ByVal sA as string) as string
dim sASplit() as string
sASplit() = split(sA, ".")
sASplit() = split(sASplit(1), "$")
getColonna = sASPlit(1)
end function
function getRigaIniziale(ByVal sA as string) as string
dim sASplit() as string
sASplit() = split(sA, ".")
sASplit() = split(sASplit(1), ":")
sASplit() = split(sASplit(0), "$")
getRigaIniziale = sASPlit(2)
end function
function getRigaFinale(ByVal sA as string) as string
dim sASplit() as string
sASplit() = split(sA, ".")
sASplit() = split(sASplit(1), ":")
sASplit() = split(sASplit(1), "$")
getRigaFinale = sASPlit(2)
end function
'********************************************************
'********************************************************
'********************************************************
'REM MODULO 2
Global oRangeSelectionListener As Object
Global sA as string
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 = "My Title"
mArgs(2).Name = "CloseOnMouseRelease"
mArgs(2).Value = True
oDocView.startRangeSelection(mArgs())
End Sub
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]
