domenica 13 febbraio 2011

Corno di Medale - Via Cassin

L'appuntamento a Lecco era per le 7.30.
Ero già in strada alle 7.10 quando mannaggia! inizia a piovere ... Beh mal che vada beviamo il caffè e torniamo a casa ...
La giornata è cominciata così, la Cassin è la via più facile del Medale ... 350 metri di 4°-5° ... è la via sicuramente più unta, diciamo pure saponosa :-) perdersi è impossibile anche per chi la sale per la prima volta ... basta seguire il luccichio della roccia.
E' una via a cui però sono affezionato, è la via di inizio stagione la prima quando si è proprio giù d'allenamento e si vuole riprendere a scalare ... è il mio caso attuale :-)
Oggi però la via non era solo unta era anche (almeno per i primi 5 tiri) sporca ... sporchissima di terra, una combinazione (unto e terra) da far venire la tremarella. Stanno richiodando 1 forse 2 vie a destra, dove c'è Sulla rotta di Poseidone ... credo siano la Via della Formica e la via dei Ragni .... però non ne sono sicuro ... fatto è che quella parte di parete a destra della Cassin è solcata da 2 serie di corde fisse ... così mentre ripuliscono e mettono in sicurezza, sporcano la super classica ... un consiglio quindi a chi volesse salirla, aspettate una bella pioggia :-)

Qui sotto la parete vista dall'attacco


Ci cambiamo ...


 In sosta fumiamo :-)

 
 Le scarpe ... ne ho un paio nuovo ... ma fanno ancora male ...
Però queste oramai sono proprio da buttare :-)


 Mi sembra quasi di scalare a piedi nudi (quello bianco in effetti è proprio il pollice :-)



Il tiro più famoso, l'ardito traverso ... 




E qui sotto un primo piano del traverso ... la parte bianca è la roccia martellata per renderla ruvida ... purtroppo l'esito non garantisce maggiore presa ... i piedi scivolano come sul ghiaccio ...  

sabato 5 febbraio 2011

Una gita in Grignetta

Oggi riprendo a scrivere sul blog, dopo mesi di inattività ... c'era un sito da far crescere (e90e50).

Con Marco e Noureddine siamo stati in Grignetta ... "c'è troppa neve Marco per scalare in Grigna, andiamo in Medale" ... "ma va ... figurati ... andiamo con le scarpe del tennis" ... infatti :-) è vero siamo andati con le scarpe del tennis, e abbiamo scalato sul secondo Magnago (via Gandini) ... un tiro, due ... (che fatica sullo strapiombo ... sono proprio una sega e a scalare non ti regala niente nessuno ... Robb ti devi allenare!) ... comunque terzo tiro ... e... a casa, via a casa, doppie e via :-) ghiaccio e neve e anche se li è solo terzo a casa! anzi al bar per una birra :-)
Temperatura quasi estiva al sole ... in ombra e quando sul terzo tiro siamo scappati, faceva freddino ... ma appena appena di quello che non da fastidio.












mercoledì 17 febbraio 2010

Contare massimo numero di valori consecutivi

In A1:A10 i dati, in B1 il valore che si desidera analizzare.
La formula matriciale qui sotto restituisce il massimo numero di celle consecutive che contengono un valore uguale a quello in B1

=MAX(FREQUENZA(SE(A1:A10=B1;RIF.RIGA(A1:A10));SE(A1:A10<>B1;RIF.RIGA(A1:A10))))

Una variante consente di contare il numero massimo di celle vuote (o meglio vuote o contenenti "")

=MAX(FREQUENZA(SE(A1:A10="";RIF.RIGA(A1:A10));SE(A1:A10<>"";RIF.RIGA(A1:A10))))

ancora ... stessa valutazione ma su più parametri ...
dati in A1:B10 ... parametri in C1 e D1 questa formula:

=MAX(FREQUENZA(SE((A1:A10=C1)*(B1:B10=D1);RIF.RIGA(A1:A10));SE((A1:A10=C1)*(B1:B10<>D1);RIF.RIGA(A1:A10))))

restituisce il numero massimo consecutivo di valori che rispettano le condizioni:
A1:A10 uguale a C1 e B1:B10 uguale a D1

saluti
r

mercoledì 20 gennaio 2010

Una frana a Scarenna ... o forse no?

Scarenna è la falesia storica che si trova tra Erba e Canzo ... è dove ho cominciato a scalare ... dove molti hanno mosso i primi passi.
L'anno scorso ricordo uno striscione appeso sulla roccia ... c'era scritto "No alla cava".
Sembrava che volessero *chiudere* la falesia, quel calcare prezioso serviva per produrre cemento ... poi pìù nulla.
Domenica la sorpresa, 100 metri prima della falesia ... la strada è bloccata, una frana invade la carreggiata della piccola strada che costeggia la palestra di roccia.
Frana naturale ... o frana *voluta?
Pensare male è peccato ... ma spesso ci si azzecca.
E tu come la pensi?

ciao
r
p.s. Le foto della frana



martedì 12 gennaio 2010

Maiuscolo iniziale migliorato

La funzione di Excel MAIUSC.INIZ converte tutte le parole della stringa passata come argomento in parole minuscole con l'iniziale maiuscola ... non è certo molto utile se non per un elenco di nomi e cognomi.
La function (anche UDF) che propongo permette di convertire un testo esteso in modo da rispettare alcune regole grammaticali. Il testo passato come argomento viene modificato infatti solo nelle lettere di inizio frase, nelle lettere che seguono ad un ritorno a capo e nelle lettere che seguono un punto, un punto esclamativo e un punto interrogativo. Segue una routine per testare il risultato.
Sarebbe possibile fare il trim prima o la conversione a lcase ... ma volendo, appunto, se desiderato si può farlo prima di passare l'argomento alla function.
Saluti
r


Function MaiuscoInizialeMigliorato( _
ByVal s As String) As String
'__________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Di Roberto Mensa nick r
'__________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Dim v, i As Long
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.Pattern = _
"(^|[.!?]\b|[.!?]\s+\b|\r\b|\f\b|\n\b)(.)"
re.Global = True
MaiuscoInizialeMigliorato = _
re.Replace(s, "$1§$2§")
v = Split(MaiuscoInizialeMigliorato, _
"§", , vbTextCompare)
For i = 1 To UBound(v) Step 2
v(i) = VBA.StrConv(v(i), vbUpperCase)
Next
MaiuscoInizialeMigliorato = Join(v, "")
End Function


Sub test()
Dim s As String
s = "questo è un testo di prova. " & _
"tutto minuscolo." & _
vbNewLine & _
"le minuscole diventano maiuscole" & _
" se a inizio frase!" & _
vbNewLine & _
"le minuscole diventano maiuscole" & _
" se dopo un punto, punto " & _
"esclamativo o un punto di domanda" & _
vbNewLine & _
"le minuscole diventano maiuscole" & _
" se dopo un a capo."
MsgBox s, vbOKOnly, "prima"
MsgBox MaiuscoInizialeMigliorato(s), _
vbOKOnly, "Dopo"
End Sub

lunedì 11 gennaio 2010

Cavandoli test ... il secondo test per esperti di Excel

Ecco in arrivo per colleghi e amici il secondo Cavandoli Test ... scarica il file a questo link
Buon divertimento :-)
saluti
r

p.s.
scorrendo poi fino in fondo troverete anche un mio ritratto :-)
ho dovuto colorare a mano quasi 100.000 celle
ci credete vero?
:-)

venerdì 8 gennaio 2010

Attrattori Strani (Peter de Jong - Grafici Excel)

Qualche giorno fa nell'NG di excel, Giovanna chiedeva se era possibile in excel visualizzare un attrattore strano. Sinceramente non sapevo neppure cosa fossero ... cosi ho seguito i link dove si spiegava cosa fossero (link a Wikipedia, e altri ... link, link2).

Ben presto mi sono appassionato a questo gioco di curve e casualità ... così ho preparato una cartella di excel che consente di *giocare* nel vero senso della parola, con le curve di Peter de Jong ... poi ho trovato una variante e ne ho inventate altre due (la numero 3 e 4) giusto per rendere il gioco più vario :-)

Nel file che potete scaricare cliccando Qui (il file contiene macro e va salvato per evitare errori nell'esecuzione delle stesse) troverete tutto il necessario per creare serie casuali, salvare le più belle, creare in automatico grafici di differenti colori e con numero differenti di punti ... da 10.000 a 200.000 ... è consigliabile giocare con serie di 10.000 punti per eventualmente aumentarne dopo il numero di punti, questo consentirà di avere aggiornamenti veloci del grafico oppure vedere quale risultato restituisce la stessa serie con le varianti 2, 3 o 4.

Un esempio




il link della discussione nell'NG

il link nel blog di Giovana

Saluti
r

lunedì 4 gennaio 2010

Convertitore di Valuta (Componente aggiuntivo Excel 2003)

Eccomi superstite dalle vacanze natalizie :-)

Quello che propongo è uno strumento di conversione delle valute.

Il componente aggiuntivo è scaricabile cliccando Qui.

Su come e dove salvare il componente aggiuntivo consultate la guida in linea al paragrafo:

"Risolvere i problemi relativi ai componenti aggiuntivi"

Una volta salvato il file sarà possibile aggiungere i riferimenti dal menu Strumenti->Componenti aggiuntivi ... eventualmente è possibile utilizzare il pulsante sfoglia per cercare il file.

Il convertitore utilizza una connessione tramite Internet Explorer a Google, lancia poi una ricerca tramite l'uso di parole chiave recuperando il risultato dello strumento calcolatrice di Google ...

un esempio può facilmente illustrare cosa avviene ... questa è una stringa che consente di eseguire in google una ricerca del tipi converti un euro in dollari statunitensi:

http://www.google.it/search?q=1+EUR+in+USD

Nella pagina che vi si apre noterete in alto il risultato dello strumento calcolatrice di google ... quel numero è ciò che viene recuperato come risultato della conversione dal componente aggiuntivo ... :-)

In questo modo deleghiamo a Google l'aggiornamento degli indici di conversione ... un grazie sentito :-)

Una volta aggiunto il componente all'apertura di Excel verrà creata una barra non ancorata con un pulsante per visualizzare la Form del convertitore.



Nelle due Combo sono visualizzati gli elenchi delle valute utilizzabili nella conversione.

Nella prima colonna troverete il codice di 3 lettere che si riferisce alla valuta (ad esempio EUR per l'euro), nella seconda il nome della valuta e nella terza i paesi in cui viene utilizzata.

Cliccando sui titoli di colonna otterrete l'ordinamento alternativamente crescente e decrescente ad ogni click relativamente al titolo su cui volete l'ordinamento.

Alla chiusura della form il risultato della conversione viene copiato in memoria, sarà quindi disponibile ad essere incollato nella cella desiderata.

Non scegliendo alcun valore dalla seconda combo, la conversione avverrà di defoult in euro.

E' superfluo dire che perchè funzioni correttamente deve essere installato Internet Explorer e il computer deve essere connesso a Internet.

Il progetto VBA non è protetto, il codice non è però commentato, anche se sarà facile capirne il funzionamento.

Che dire ... buon divertimento

Saluti
r

p.s.

cliccando Qui è possibile scaricare la cartella di lavoro (xls) ... successivamente potrete salvare con nome come componente aggiuntivo di Excel, in questo modo il file xla verrà salvato automaticamente nella cartella dove sono contenuti i AddIns

domenica 6 dicembre 2009

Sogni proibiti - Antimedale (Lecco)

Al mattino, 7.30 a Lecco ... i primi ad arrivare sono Guido e Jeck ...
Giacomo è molto che non lo incontro, un abbraccio e tante pacche sulle spalle, non è cambiato (a parte la barba imbiancata :-) Jack l'artista ... Jack il matto ... al bar li immortalo, un bianchino di prima mattina per cominciare bene la giornata.



Guido viene da un infortunio ... è caduto un po' di tempo fa ... si è rotto le costole ed oggi riprende per la prima volta a scalare ... dimenticavo ... è caduto dalle scale :-) mica mentre scalava ... oh Guido ... comunque loro andranno a fare la Chiappa io e Marco puntavamo alla Bonatti in Medale ma da sotto la ferrata vediamo che è ancora bagnata (ha piovuto venerdì) ... così decidiamo per Sogni proibiti nell'antimedale.

Si attacca sulla via degli istruttori ... dopo i primi due tiri si traversa a destra per 100 metri rimontando verso il pilastro a destra del canale ... la via attacca proprio dove c'è l'albero ... in tutto sono altri 4 tiri ... il primo ti sveglia fuori, fa anche un po' freddo ...
Via nel complesso faticosa (per il nostro livello di allenamento) diciamo che le difficoltà sono di 5°-6° sostenuti tirando un po' di chiodi ... in libera credo 6c ... noi alla libera non ci pensiamo nemmeno e già così ne usciamo rotti ... nella via uso anche alcuni nuts (medio piccoli) e frend (medio piccoli) ... non l'avevo ancora ripetuta da quando è stata richiodata ... e come già accaduto ... snaturata ... così alcuni passaggi sono più obbligati ... sul terzo tiro sono aggiunti due fittoni su una placca a lato del percorso originale (un diedro giallo con alcuni frigoriferi appoggiati) ... la placca sembra dura quindi rimango sui blocchi ... fare attenzione a cosa prendo in mano mi dico ... si sbuca sulla ferrata del Medale all'altezza dell'attacco di Bonatti e Brianzi ... ma ... per oggi a noi basta così ... andiamo in vetta per fare due passi ancora e fumare una sigaretta.

Marco attacca la via degli istruttori ...



Marco sul secondo tiro



Devo imparare a tenere il cellulare dritto :-)

video

video

giovedì 19 novembre 2009

Organigrammi - Excel 2003

Quello che propongo è un lavoro di quest'estate, mi ero ripromesso di apportare alcune modifiche, purtroppo non ho ancora avuto il tempo ... e ho paura che non lo avrò ancora per molto ... quindi prima che finisca nel dimenticatoio ... eccolo ... sotto la descrizione sommaria ...

il file è scaricabile cliccando qui

Attenzione! per il corretto funzionamento il file va salvato, contiene infatti Riferimenti aggiunti.

Versione Excel 2003

Contiene macro - Riferimenti aggiunti a:

  • Microsoft Window Common Controls 6.0 (SP&)
  • Microsoft Scripting Runtime
  • Controlli TreeView e Spreadsheet (un messaggio iniziale chiederà di attivare i controlli ActiveX)

Descrizione:

All''apertura del file viene creata una Barra non ancorata contenente due pulsanti. Il primo "Creazione Guidata" richiama la Form per la costruzione di un organigramma e la modifica di organigrammi già esistenti salvati come origine dati in fogli il cui nome è preceduto da O_ oppure O_P_.

Il secondo richiama una Form che aiuta nell'aggiunta di nodi direttamente su un foglio origine dati.

La creazione di organigrammi è semplificata grazie all'uso di una TreeView che aiuta a visualizzare la classica struttura ad albero sono poi presenti opzioni che consentono la modifica, l'eliminazione, l'aggiunta o lo spostamento dei nodi.

Una Form contenente un controllo Spreadsheet consente l'aggiunta di più nodi ad un unico nodo padre.

Ad ogni nodo sono associati due campi testo più la possibilità di scegliere se il nodo è un subordinato o un collaboratore.La creazione di diagrammi gerarchici prevede la possibilità di organizzare il campo testo delle singole caselle, grazie ad una Form dedicata.

E' possibile creare i diagrammi in un documento Word, una presentazione PowerPoint oppure in un nuovo Foglio o in una nuova Cartella Excel.

E' possibile scegliere il Layout del primo nodo e dei nodi successivi.

Organigrammi molto grandi producono diagrammi di difficile visualizzazione, per questo dato un organigramma è possibile isolare un singolo ramo e trattarlo separatamente.

Il salvataggio dei dati che costituiscono l'organigramma o il ramo isolato è consentito in due formati di foglio Excel e due di file XML. Questa seconda opzione è molto sperimentale e forse più una curiosità che una utilità vera e propria, comunque il formato

XML 2D trasforma l'organigramma in una tabella che successivamente riaperta in excel come elenco mostrerà l'organigramma come una normale tabella in cui ogni colonna è un livello sempre più esterno della struttura.

Il formato XML 3D invece crea uno schema analogo alla visualizzazione nella TreeView.Nel foglio Esempio1 viene mostrato come creare un foglio di Origine del tipo O_P_ a partire da una semplice tabella.

Nel foglio Esempio2 viene mostrato come è possibile usare un elenco di path per generare un Organigramma.

I fogli con prefisso E_ vengono utilizzati come elenchi di nodi da organizzare nella creazione dell'organigramma. Di questi fogli viene estratto l'elenco univoco dei testi e reso disponibile nella combo di assegnazione del nuovo nodo, una volta aggiunto il nodo la voce viene eliminata dalla combo. E' anche possibile copiare in memoria per esempio una serie di celle e ottenere lo stesso

risultato. Se la memoria è invece occupata da un testo verrà creato l'elenco con le singole parole lunghe almeno 4 caratteri.

Per imparare ad usare questo strumento il modo migliore è creare un organigramma a partire da zero, giocarci, salvare l'origine dati riaprirla e modificarla. I fogli presenti nella cartella sono origini dati già create con le quali è possibile fare prove.In particolare i fogli Modello_Oggetti ricostruiscono lo schema del modello delle applicazioni Office.

Questa cartella si presta ad essere trasformata in un componente aggiuntivo salvandola come xlm.

Il codice del progetto è commentato, le routine sono state divise in 3 moduli per chiarezza nella lettura. Il codice delle form è commentato solo parzialmente. Le funzioni nel modulo Funzioni sono molto generiche e riutilizzabili, consiglio quindi di leggerle attentamente.

saluti

r

mercoledì 18 novembre 2009

UDF Join

La funzione CONCATENA di Excel ha molti limiti, non è possibile utilizzarla con formule matriciali, non è possibile passare un range di più celle ... la UDF mcat di Harlan Grove risolve questi problemi in modo egregio, una funzione veramente ottima. In sostanza è un CONCATENA con le caratteristiche della funzione SOMMA, quindi accetta un numero arbitrario di parametri, che possono essere rappresentati anche da range di più celle ... può inoltre essere utilizzata in una funzione matriciale, veramente eccezionale ... eccola:

Function mcat(ParamArray S()) As String
'Copyright (C) 2002, Harlan Grove
'This is free software. It's use in derivative works is covered
'under the terms of the Free Software Foundation's GPL. See
'http://www.gnu.org/copyleft/gpl.html
'------------------------------------
'string concatenation analog to SUM
Dim R As Range, x As Variant, y As Variant


For Each x In S
If TypeOf x Is Range Then
For Each R In x.Cells
mcat = mcat & R.Value
Next R
ElseIf IsArray(x) Then
For Each y In x
mcat = mcat & IIf(IsArray(y), mcat(y), y)
Next y
Else
mcat = mcat & x
End If
Next x
End Function



da questa funzione ho tratto spunto per creare una UDF simile all'utilissima Join di VB ... JoinUDF restituisce una stringa creata dall'unione di sottostringhe contenute nel parametro Source e delimitate dal parametro Delimiter.
Source sarà quindi un range di più celle o una matrice, Delimiter potrà essere un qualsiasi valore, oppure un range o una matrice (in questi casi sarà il concatenamento delle sottostringhe).
Analogamente a Join questa funzione può essere usata per concatenare stringhe, omettendo Delimiter infatti verrà usato come delimitatore la stringa di lunghezza zero (la funzione Join viceversa usa come defoult lo spazio).


Function JoinUDF( _
Source As Variant, _
Optional Delimiter As Variant = "") As String

'di Roberto Mensa Nick r
Dim Rng As Range, x() As String, y As Variant
Dim i As Long

If TypeName(Source) = "Range" Then
ReDim x(Source.Count - 1)
For Each Rng In Source
x(i) = CStr(Rng.Value)
i = i + 1
Next
ElseIf IsArray(Source) Then
For Each y In Source
ReDim Preserve x(i)
x(i) = CStr(IIf(IsArray(y), JoinUDF(y), y))
i = i + 1
Next
Else
ReDim x(0)
x(0) = CStr(Source)
End If

If IsArray(Delimiter) Or TypeName(Delimiter) = "Range" Then
Delimiter = JoinUDF(Delimiter)
End If
JoinUDF = Join(x, CStr(Delimiter))

End Function

saluti
r

mercoledì 4 novembre 2009

Grafici a Cruscotto (Excel)

Ultimamente mi sto appassionando ai grafici a Cruscotto ... tipo tacchimetro dell'auto :-)
allego due file, ho aggiunto un effetto acceleratore, le Macro contenute riguardano solo questo ... per il resto funzionano con le normali funzionalità di Excel
Link 1
Link 2

saluti
r

Osvaldo Cavandoli - Grafici a dispersione (Excel)

Dopo il Cavandoli Test ... per chi vuole esercitarsi con i grafici a dispersione ... alcune immagini della Linea del mitico Osvaldo Cavandoli ...
Link al file
saluti
r

martedì 3 novembre 2009

Scomposizione in fattori primi (VB)

Due agili funzioni per la scomposizione in fattori primi di un numero.
Saluti
r

Public Function Fattori_primi( _
ByVal N As Long)

Dim F As Long
Dim T As Long
Dim R As Long
Dim S As String
'si basa sul principio che un numero
'e primo se non ha divisori > della
'sua radice
R = Sqr(N)
T = N Mod 2 + 1
F = 1
If N = 1 Then
S = N
Else
Do Until F > R
F = F + T
If (N) Mod F = 0 Then
S = S & F & "*"
N = N / F
F = F - T
R = Sqr(N)
End If
Loop
If N = 1 Then
S = Left(S, Len(S) - 1)
Else
S = S & N
End If
End If

Fattori_primi = S
'volendo una matrice sostituire con
'Fattori_primi = Split(S, "*")

End Function


Public Function PrimiB2(ByVal N As Long) As Long()
'di Nur
Dim arrF() As Long
Dim F As Long, NP As Long, d As Long
Dim Stp As Long, Radice As Long
If N = 1 Then
ReDim arrF(0)
arrF(0) = 1
Else
Radice = Sqr(N)
d = 1
Stp = N Mod 2 + 1
Do Until d > Radice
d = d + Stp
If N Mod d = 0 Then
NP = NP + 1
ReDim Preserve arrF(NP - 1)
arrF(NP - 1) = d
N = N / d
d = d - Stp
Radice = Sqr(N)
End If
Loop
If d < N Then
ReDim Preserve arrF(NP)
arrF(NP) = N
ElseIf d = 1 Then
ReDim arrF(0)
arrF(0) = N
End If
End If
PrimiB2 = arrF
End Function

TextBox con convalida dati (MSForm - VBA - VBScript)

Le caselle di testo (controllo TextBox) sono tra i controlli più utilizzati nella creazione di UserForm. Sono adatti alla visualizzazione dei dati, ma spesso vengono utilizzati per raccogliere l'input. A questo riguardo è bene specificare che i dati che vengono imputati nelle TextBox sono testo, ovvero dati di tipo string. I problemi nascono quando si desidera immettere dei tipi di dato diversi, per esempio date o numeri. In questi casi è sempre bene controlarne l'immissione effettuando una convalida del dato.
Propongo un esempio che utilizza le Espressioni Regolari per verificare se il dato è stato scritto correttamente. Il controllo viene eseguito nell'evento Exit e utilizza una routine generica a cui viene passato il pattern. Ho preferito avvisare l'utente scrivendo in un controllo Label l'eventuale messaggio di errore, piuttosto che utilizzare fastidiosi messaggi di errore.


'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'per l'esempio inserire una nuova

'UserForm (UserForm1) contenente:
'una Label (Label1) e tre TextBox

'(TextBox1, TextBox2, TextBox3)
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'altri path si trovano a questo indirizzo:
'http://excelvba.altervista.org/blog/index.php/Excel-VBA/Espressioni-Regolari-e-Pattern-applicazione-Form.html

'Incollare tutto il codice nel modulo
'di classe della Userform

Private Sub UserForm_Initialize()
With Me
.Caption = "Esempi TextBox con convalida"
.Label1.Caption = ""
.Label1.ForeColor = &HFF&
.TextBox1.Tag = "Data Europea"
.TextBox2.Tag = "Codice Fiscale"
.TextBox3.Tag = "Numero decimale"
.TextBox1.Text = "12/10/2009"
.TextBox2.Text = "DVXJHT61B12Z600F"
.TextBox3.Text = "2,5"
End With
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'data europea
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox1, _
Cancel, _
"^(3[01][12]\d0?[1-9])/(0?[13578]1012)/" & _
"(\d{2}(192021)\d{2})$" & _
"^(30[12]\d0?[1-9])/(0?[469]11)/(\d{2}" & _
"(192021)\d{2})$" & _
"^(2[0-8][01]\d0?[1-9])/(0?2)/(\d{2}" & _
"(192021)\d{2})$" & _
"^29/(0?2)/(200000)$" & _
"^29/(0?2)/(192021)?(0[48][2468][048]" & _
"[13579][26])$"
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'codice fiscale
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox2, _
Cancel, _
"^([A-Z]{6})" & _
"(((\d{2})[ACELMRT](3[01][12]\d0[1-9]" & _
"7071[56]\d4[1-9]))" & _
"((\d{2})[DHPS](30[12]\d0[1-9]70" & _
"[56]\d4[1-9]))" & _
"((\d{2})B(2[0-8]1\d0[1-9]6[0-8]5\d4[1-9]))" & _
"((0[048][2468][048][13579][26])B(2969)))" & _
"([A-Z]{1})([0-9L-NPQ-V]{3})" & _
"([A-Z]{1})$"

End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'numero a virgola mobile
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox3, _
Cancel, _
"^(0[+-]?" & _
"((?!0)\d+([,]\d+)?" & _
"[0]+([,]\d+)?))$"

End Sub


Sub UserForm_Controllo_Event_Exit( _
ByRef oLabel As MSForms.Label, _
ByRef oControl As MSForms.Control, _
ByRef Cancel As MSForms.ReturnBoolean, _
Optional ByVal sPattern As String = "[\w\s]+")
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Di Roberto Mensa nick r
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Effettua un controllo sul testo digitato in un
'controllo, se il controllo ha esito negativo
'ripassa cancel=true impedendo l'uscita del focus
'e seleziona l'intero testo digitato
'da richiamare dall'evento exit di controlli che
'hanno cancel come argomento
'oLabel è il controllo Label entro cui comunicare
'il messaggio di errore

Dim re As Object
Static sLabelCaption As String
Static bCancel As Boolean

If bCancel = False Then
sLabelCaption = oLabel.Caption
End If

Set re = CreateObject("vbscript.regexp")
re.Pattern = sPattern
re.ignorecase = True
With oControl
If Len(.Text) > 0 Then
If re.test(.Text) = False Then
oLabel.Caption = _
"Testo " & .Tag & " - Non valido!"
.SelStart = 0
.SelLength = Len(.Text)
Cancel = True
bCancel = True
End If
End If
End With
If Cancel = False Then
bCancel = False
oLabel.Caption = sLabelCaption
End If
End Sub

lunedì 2 novembre 2009

CSV per ogni foglio della Cartella Excel attiva (Excel - VBA)

Il codice che propongo serve a creare, partendo dai dati contenuti nei fogli di una Cartella di Lavoro, una serie di file csv (o txt).
Il salvataggio con nome dei file di questo tipo infatti eseguito da codice VB non riconosce i delimitatori decimali in modo corretto, così la virgola viene sostituita dal punto ...
Viene usato un riferimento alla libreria Scripting per utilizzare l'oggetto FileSystemObject.
Per conoscere l'enorme potenzialità del FSO troverete molti esempi nella guida in linea di VBScript. Leditor VBScript è raggiungibile dal menu Strumenti->Macro->Microsoft Script Editor ... (potrebbe essere richiesta l'installazione al primo accesso eventualmente dare OK) ... nella guida in linea dell'editor è poi consultabile il capitolo vbscript all'interno del quale troverete gli argomenti legati al FileSystemObject.
Saluti
r

Option Explicit
'in un modulo standard del progetto VBA

Sub csv_tutti_i_fogli()
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Di Roberto Mensa nick r
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'crea per ogni foglio della cartella di lavoro
'un file csv o txt (modificando la costante
'Estensione_file)
'i file vengono salvati nel percorso nella stessa
'posizione della cartella attiva
'se un file csv con lo stesso percorso-nome esiste
'già sarà sovrascritto
Dim Sh As Excel.Worksheet
Dim Rng As Excel.Range
Dim S As String
Dim FSO As Object
Dim tS As Object
Dim Wb As Excel.Workbook
Dim sPath As String
Const ForWriting As Long = 2
Const Estensione_file As String = ".csv"
Set Wb = ActiveWorkbook

Set FSO = CreateObject("Scripting.FileSystemObject")
sPath = Wb.Path '<< eventualmente da cambiare
On Error Resume Next
For Each Sh In Wb.Worksheets
Set Rng = UsedRange_Value(Sh, , True)
S = CSV_text(Rng)
Set tS = FSO.OpenTextFile(FSO.BuildPath( _
sPath, Sh.Name & Estensione_file _
), ForWriting, True)
tS.Write S
tS.Close
Next
End Sub
Function CSV_text( _
Rng As Excel.Range, _
Optional D As String = ";") As String
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Di Roberto Mensa nick r
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'il parametro opzionale D indica il delimitatore
'da utilizzare nella scrittura del file
Dim R As Long, C As Long
Dim S As String, St As String

For R = 1 To Rng.Rows.Count
St = ""
For C = 1 To Rng.Columns.Count
St = St & D & Rng(R, C).Text
Next C
If Len(Replace(St, D, "")) Then
St = Right(St, Len(St) - 1)
Else
St = ""
End If
S = S & St & VBA.Constants.vbNewLine
Next R

CSV_text = VBA.Left(S, Len(S) - 2)
End Function
Function UsedRange_Value( _
Optional Sh As Worksheet, _
Optional Rng As Range, _
Optional WithFormulas As Boolean = False) _
As Excel.Range

'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Di Roberto Mensa nick r
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Restituisce il minimo range rettangolare
'che comprende tutte le celle valorizzate
'nel foglio o nel range che passiamo come
'argomento

'Restituisce Nothing se nessuna cella è
'valorizzata

'passando Sh verrà ignorato Rng

'non passando argomenti verrà ricercata
'il range nel foglio attivo della cartella
'attiva contenente solo le celle contenenti
'un valore costante

'passando WithFormulas = True verranno
'considerate anche le celle contenenti una
'formula

Dim S As String, tS As String
Dim RE As Object
Dim maxR As Long, minR As Long
Dim maxC As Long, minC As Long
Dim V

'Verifico i primi due argomenti e setto
'il range di ricerca
If Sh Is Nothing Then
If Rng Is Nothing Then
Set Rng = [a1].Parent.UsedRange
End If
Set Sh = Rng.Parent
Else
Set Rng = Sh.UsedRange
End If

On Error Resume Next
'setto il range alle celle contenenti un valore
'costante
Set UsedRange_Value = Rng.SpecialCells( _
xlCellTypeConstants)

'Controllo il parametro opzionale
If WithFormulas Then
'aggiungo le celle contenenti le formule
If TypeName(UsedRange_Value) = "Nothing" Then
Set UsedRange_Value = _
Rng.SpecialCells(xlCellTypeFormulas, 23)
Else
Set UsedRange_Value = _
Union( _
UsedRange_Value, _
Rng.SpecialCells(xlCellTypeFormulas, 23))
End If
End If

On Error GoTo 0
'verifico che il range non sia vuoto
If TypeName(UsedRange_Value) = "Range" Then
'verifico se contiene più aree
If UsedRange_Value.Areas.Count > 1 Then
'recupero le coordinate per settare
'il range rettangolare
'ATTENZIONE!
'Comportamento non documentato di
'Address riferito a Range
'Rng.Address restituisce fino a 257
'caratteri
For Each V In UsedRange_Value
S = S & V. _
Address(True, True, xlR1C1)
Next
Set RE = CreateObject("vbscript.regexp")
RE.Global = True

RE.Pattern = "C\d+:,"
tS = RE.Replace(S, "")

RE.Pattern = "\d+"
maxR = RE.Execute(tS)(0)
minR = maxR
For Each V In RE.Execute(tS)
If V < minR Then
minR = V
ElseIf V > maxR Then
maxR = V
End If
Next

RE.Pattern = "R\d+:,"
tS = RE.Replace(S, "")

RE.Pattern = "\d+"
maxC = RE.Execute(tS)(0)
minC = maxC
For Each V In RE.Execute(tS)
If V < minC Then
minC = V
ElseIf V > maxC Then
maxC = V
End If
Next
Set UsedRange_Value = Sh.Range( _
Sh.Cells(minR, minC), _
Sh.Cells(maxR, maxC))
End If
End If
End Function

sabato 31 ottobre 2009

Via Taveggia - Corno di Medale (Lecco)

Per chi come me è vicino a Lecco ... è cominciata la stagione del Medale :-)
Si parte dalla Cassin ... e la settimana seguente si passa alla Taveggia ...
Via di quinto grado ... 6a forse ... ma poco obbligato ...
All'attacco c'è scritto il nome della via ... quindi impossibile sbagliare ... la relazione noi non l'avevamo ... ma la via non richiede molto senso dell'orientamento ... si può sbagliare solo negli ultimi tiri ... infatti ho sbagliato :-) direi che l'unico consiglio è ... attenzione agli ultimi due tiri quelli prima dell'uscita dalla via (III) ... alla partenza del pen'ultimo tiro, dopo il primo fittone io ho tenuto dritto in un diedrino (chiodo e piastrina poco affidabili) la via invece passa a destra, certo il chiodo sembra chiamare "è di qui vieni ... c'è anche una piastrina ..." così io mi ci infilo ... ma la roccia diventa rotta e instabile, se proprio decidete di fare questa variante occhio a dove mettete mani e piedi ... comunque ... rimontato il diedro (chiodo) si recupera la via.Anche sull'ultimo tiro (toccato a Valter) attenzione ... tenere sempre la destra ... come in autostrada ... è andate sul sicuro ... spostarsi a sinistra si trovano dei chiodi ma si finisce su roccia marcia ... i fittoni sono un po' distanti ma le difficolta non superano il quinto grado.
Ecco ... questi i consigli, per il resto la via non merita certo molte parole ... è unta ... molto unta sopratutto i primi tiri ... la paura che il piede scivoli via ti accompagna sui passaggi obbligati ... sui primi tiri anche la vegetazione infastidisce ... proseguendo diminuisce.
Nota positiva è la stretta vicinanza con le vie Eternium e Messico e Nuvole ... per noi (fuori allenamento) ancora troppo impegnative ... ma bello vedere gli amici Luciano e Stefano arrampicarci sopra. La sosta dell'ultimo tiro offre una posizione ideale per scattare foto a Luciano sul tiro chiave di Messico e Nuvole una placca mozzafiato che termina con una fessura (5 protezioni sul tiro di 20-25 metri). Settimana prossima l'Anniversario ...

Lecco all'alba ...

Il Medale ... e Valter

L'attacco della via ...

a metà parete ...
Il primo diedro visto dalla sosta ...
Luciano su Messico e Nuvole ... il tiro chiave ...









































Funzioni ricorsive (VB)

ecco due funzioni ricorsive semplici semplici ... io amo le funzioni di questo tipo ... risultano spesso sconvenienti ma sono affascinanti ... e aiutano a ragionare in modo diverso ... la prima è per verificare il numero di dimensioni di una matrice ... la seconda serve a calcolare il fattoriale di un numero ...

Function N_Dim(arr As Variant, Optional ByVal l As Long = 1) As Long
On Error Resume Next
ArrayDims = LBound(arr, l)
If Err Then
N_Dim = l - 1
Else
N_Dim = N_Dim(arr, l + 1)
End If
End Function

Function Fact_If(ByVal N As Long) As Double
'Funzione ricorsiva per il calcolo del fattoriale
'di un numero
Fact_If = N
If N <> 1 Then Fact_If = Fact_If * Fact_If(N - 1)
End Function

Cavandoli Test (Excel - grafici a dispersione)

Ecco cosa ho scritto nella mail inviata ai colleghi
"vi giro un breve test per verificare la vostra preparazione riguardo ai grafici a dispersione in Excel" in allegato il file che potete scaricare a questo link
Link al file

venerdì 30 ottobre 2009

Ordinali Inglesi (Excel-VBA-VBSript)

Da una piacevole conversazione con Nur sono nate alcune funzioni che propongo ...
Della serie ... Funzioni inutili ... ecco English_Ordinal O_R e Ordinals_R che trasforma un numero nel rispettivo ordinale inglese ... e Is_Ordinal che verifica se la stringa passata come argomento è o meno un ordinale inglese.
Il gioco stava nel *costringersi* ad usare le RegExp ... ma in questo caso forse hanno perso la gara ...

'in un modulo standard dell'editor vb di excel
'lanciare test
Sub test()
Dim i As Long
For i = 0 To 999
Cells(i + 1, 1) = English_Ordinal(i)
Cells(i + 1, 2) = Is_Ordinal(CStr(Cells(i + 1, 1)))
Next
End Sub

Function English_Ordinal(L As Long) As String
Dim re As Object
Dim S As String
S = L
Set re = CreateObject("vbscript.regexp")
re.Pattern = _
"((1[2-9]1)(2[2-9]2)(3[2-9]3)([04-9]1[0-9][2-9]0[2-9][4-9]))$"
S = re.Replace(S, ";$2st$3nd$4rd$5th")
re.Pattern = "(.*);.*?(\d+[a-z]{2}).*$"
English_Ordinal = re.Replace(S, "$1$2")
End Function

Public Function Is_Ordinal(S As String) As Boolean
Dim re As Object
S = "0" & S
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "^\d*([02-9](1st2nd3rd[04-9]th))(1\dth)$"
Is_Ordinal = re.test(S)
End Function

Function Ordinals_R(l As Long) As String
Dim v, c As Long, i As Long
v = Array("th", "st", "nd", "rd")
c = Right(l, 1)
If Right(l, 2) - 10 <> c Then _
If c < 4 Then i = c
Ordinals_R = l & v(i)
End Function

Function O_R(l As Long) As String
'breve
Dim v, c As Long
v = Array("th", "st", "nd", "rd")
c = Right(l, 1)
O_R = l & v(IIf(Right(l, 2) - 10 = c, 0, IIf(c > 3, 0, c)))
End Function

giovedì 29 ottobre 2009

Spigolo Nord del Crozzon di Brenta

La sera ... prima



L'accampamento ...



La vista sul Campanil basso


Sullo spigolo ... 1

In vetta ...

Il tramonto ...

L'alba ...
La discesa ...