> No, no! si tratta di deliberata intenzione a delinquere...
:-))
> Io intendevo rigenerare la macro nelle sue intenzioni ( non era in
> quel senso che era degenerata? ), ma evidentemente ho semplificato
> troppo...
>
> (Comunque l'ho sempre detto che di quella macro ci capivo poco...)
>
> Lo strano è che a me funziona...
=-O
Strano davvero...cosa siamo riusciti a scrivere? :-)
> I miei listini non ne hanno di più... ma volendo generalizzare...
Mah, allora potrebbe essere il caso di non preoccuparsi troppo...che dici?
>> .searchString = lCase(".[A-Za-zéèòàçìù]")
>> In quest'ultima, errore mio, "lCase" non serve.
> AH ecco!! mi pareva di aver visto qualcosa... :-)
In effetti non riesco a capire perché l'avevo messo... :-\
>> ...zot...
>
> Giuro che non l'ho pasticciata così tanto...
Si, si, dicono tutti così! :-D
> Se metto Option explicit in testa ai miei moduli di macro non ne
> funziona più nemmeno una... :-(
Capisco...
>> Sto ripensando un po' tutta la macro, mi ci vorrà un po'...
> Non c'è urgenza... (i listini della Regione piemonte sono stati
> adattati)... ma se tardi troppo mi spazientisco, e va a finire che ci
> metto mano io... ee sarebbe un peccato! :-)
Ma no, dai, al massimo diventa più divertente rimetterla a posto! ^_^
Scherzo, naturalmente! ;-)
Da quello che mi hai detto sopra potrebbe non essere necessario fare
moltissimo, il mio cruccio è che molti "controlli" sono sostanzialmente
fini a sé stessi, perché non considerano decine di altre situazioni che
potenzialmente possono presentarsi, d'altro canto se li si toglie si
rischia di avere qualcosa scarsa utilità...
Io direi di mediare come al solito tra l'ideale ed il reale.
Provo ad inviare quello che ho fatto in allegato (file di testo),
sperando che passi (almeno a Bart dovrebbe arrivare), così almeno
dovrebbe mantenere l'indent.
Ho stravolto un po' quel che era la macro originaria, Bart non volermene
:-))
Non è come piacerebbe a me, ma per oggi non riesco ad andare oltre...
L'unica situazione in cui ha dei dubbi è quando è presente un solo
simbolo (punto o virgola), in tal caso assegna il significato che io ho
ritenuto più probabile...
Io l'ho provata su questi casi:
1à
2
3
4
prova 433
44,56
55'55032
543.5436
33,234,235.433
é432.43.2
234.235,433
4.444,4
55'553,22
55.555.333
5'55.
55.55
5.555
5,555
ed i risultati sono quelli che mi attendo:
1à
2,00
3,00
4,00
prova 433
44,56
55'55032
543,54
33.234.235,43
é432.43.2
234.235,43
4.444,40
55.553,22
55.555.333,00
5'55.
55,55
5.555,00
5.555,00
Sono quelli che ti aspetteresti anche tu?
Una domanda Bart: l'on-error a cui ti riferivi è quello nella sub
"Copia_Stringa"?
Beh, se è solo quello non mi sembra così deleterio...
Ciao!
Emanuele.
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 10/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 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()
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
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
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]
