Appunti , possono essere utili?

[albatros54Moderatore albatros54 Karma: 89 pts]

In allegato  un file pdf che ho creato da riviste che avevo collezionato tempo fa, posso creare altri pdf, possono essere utili?

gioacchino

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

Sono SEMPRE utili le informazioni che riceviamo.

Grazie per la condivisione e, se hai altro, ... aspettiamo

Una caro saluto,

Mario

[albatros54Moderatore albatros54 Karma: 89 pts]

Secondo appuntamento , in allegato file per chi fosse interessato

gioacchino

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[maxpitPartecipante maxpit Karma: 7 pts]

Buona serata Gioacchino,

sempre interessanti e valide queste info del tempo che fu. Mi hai permesso di fare un viaggio indietro nel tempo che ho molto apprezzato.

Grazie

[albatros54Moderatore albatros54 Karma: 89 pts]

altra dispensa  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Questi post non andrebbero dispersi

[albatros54Moderatore albatros54 Karma: 89 pts]

Buongiorno, Tips and Tricks  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Tips and Tricks  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Altra dispensa  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Tips and Tricks  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Tips and Tricks  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Tips and Tricks  

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Tips and  Ticks  

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Questo mi piace. Anch'io ho scritto una mia routine di cifratura, basata su Xor, e ultimamente mi sono dedicato alla compressione a nibbles    Bravo Albatros, sempre cose interessanti!

[albatros54Moderatore albatros54 Karma: 89 pts]

Tips and Ticks   

 

 

br>

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ti sei lanciato   

A proposito della routine di conversione da numeri a lettere... anni fa avevo scritto una sub per convertire in cifre numeriche un numero qualsiasi scritto in parole. Era venuto fuori un bel lavoro (apprezzato perfino da nick r). Peccato che quel codice sia sparito con il forum di VB T&T.

[albatros54Moderatore albatros54 Karma: 89 pts]

vecchio frac ha scritto:

Era venuto fuori un bel lavoro (apprezzato perfino da nick r)

nel mio archivio ho trovato questo file che ti allego  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

albatros54 ha scritto:

ho trovato questo file

Avevo realizzato nua cosa simile alla Function Da_1_a_99 ma molto più complessa (e diciamocelo anche meglio funzionante 🙂 ) che al momento non trovo. Sul suo famoso sito e90e50 (che non trovo più) l'aveva pubblicata.

[albatros54Moderatore albatros54 Karma: 89 pts]

vecchio frac ha scritto:

 Function Da_1_a_99 ma molto più complessa (e diciamocelo anche meglio funzionante

Forse è questa  

Option Base 1
Option Explicit

'Array contenente le lettere dei numeri
Dim Strconv(0 To 45) As String
'Name Function:     Public Function converti(strNumero)
'Author:            ... ....
'Date Crated:       17/11/2010
'Last Modified:
'Description:       Converte i numeri in lettere
Public Function Converti2(Strnumero As String)
'variabile per l'importo
    Dim CrrEuro As Currency
    'centesimi
    Dim IntCents As Integer
    'variabile di tipo stringa per i centesimi
    Dim StrCentesimi As String
    'lettere dell'importo
    Dim StrLettere As String
    'centesimi


    StrCentesimi = "00"
    'Aggiornamento dello schermo attivato
    Application.ScreenUpdating = True

    'Imposto i valori dell'array
    Strconv(0) = "zero"
    Strconv(1) = "uno"
    Strconv(2) = "due"
    Strconv(3) = "tre"
    Strconv(4) = "quattro"
    Strconv(5) = "cinque"
    Strconv(6) = "sei"
    Strconv(7) = "sette"
    Strconv(8) = "otto"
    Strconv(9) = "nove"
    Strconv(10) = "dieci"
    Strconv(11) = "undici"
    Strconv(12) = "dodici"
    Strconv(13) = "tredici"
    Strconv(14) = "quattordici"
    Strconv(15) = "quindici"
    Strconv(16) = "sedici"
    Strconv(17) = "diciasette"
    Strconv(18) = "diciotto"
    Strconv(19) = "diciannove"
    Strconv(20) = "venti"
    Strconv(21) = "ventuno"
    Strconv(22) = "trenta"
    Strconv(23) = "trentuno"
    Strconv(24) = "quaranta"
    Strconv(25) = "quarantuno"
    Strconv(26) = "cinquanta"
    Strconv(27) = "cinquantuno"
    Strconv(28) = "sessanta"
    Strconv(29) = "sessantuno"
    Strconv(30) = "settanta"
    Strconv(31) = "settantuno"
    Strconv(32) = "ottanta"
    Strconv(33) = "ottantuno"
    Strconv(34) = "novanta"
    Strconv(35) = "novantuno"
    Strconv(36) = "cento"
    Strconv(37) = "mille"
    Strconv(38) = "mila"
    Strconv(39) = "milione"
    Strconv(40) = "milioni"
    Strconv(41) = "miliardo"
    Strconv(42) = "miliardi"
    Strconv(43) = "centomila"

    'Verifico che ilvalore che sto convertendo sia numerico
    If Val(Strnumero) = 0 And IsNumeric(Strnumero) = False Then
        MsgBox "La Cella selezionata non è un numero", vbInformation + vbOKOnly, "Shareoffice.it"
        Converti2 = "#Nome"
        Exit Function
    ElseIf Val(Strnumero) > 999999999999# Then
        MsgBox "La Cella selezionata ha un valore maggiore di 999999999999 ", vbInformation + vbOKOnly, "Shareoffice.it"
        Converti2 = "#Nome"
        Exit Function

    End If

    'converto il numero in currency
    CrrEuro = CCur(Strnumero)


    ' Formattazione dei centesimi
    StrCentesimi = Right(Format(Strnumero, "##,##0.00"), 2)

    'testo per centesimi

    If CInt(StrCentesimi) < 21 And CInt(StrCentesimi) > 0 Then
        StrCentesimi = num_venti(CLng(StrCentesimi))
    ElseIf CInt(StrCentesimi) >= 21 And CInt(StrCentesimi) < 100 Then
        StrCentesimi = num_cento(CLng(StrCentesimi))
    End If




    CrrEuro = Fix(CrrEuro)

    If CrrEuro < 21 Then
        StrLettere = num_venti(CLng(CrrEuro))
    ElseIf CrrEuro >= 21 And CrrEuro < 100 Then
        StrLettere = num_cento(CLng(CrrEuro))
    ElseIf CrrEuro >= 100 And CrrEuro < 1000 Then
        StrLettere = num_mille(CLng(CrrEuro))
    ElseIf CrrEuro >= 1000 And CrrEuro < 100000 Then
        StrLettere = num_centomila(CLng(CrrEuro), 0)
    ElseIf CrrEuro >= 100000 And CrrEuro < 1000000 Then
        StrLettere = num_milione(CLng(CrrEuro))
    ElseIf CrrEuro >= 1000000 And CrrEuro < 1000000000 Then
        StrLettere = num_miliardo(CLng(CrrEuro))
        'conversione per i miliardi
    ElseIf CrrEuro >= 1000000000 And CrrEuro < 1000000000000# Then
        StrLettere = num_miliardi(Format(CrrEuro, "##,##0"))
    End If
    'restituisco il valore
    Converti2 = "(" & StrLettere & "/" & StrCentesimi & ")"




End Function


Private Function num_venti(LngNum As Long)
    num_venti = Strconv(LngNum)
End Function

Private Function num_cento(LngNum As Long)
    Dim inNum1 As Integer
    Dim IntNum2 As Integer
    Dim StrLettera As String
    On Error GoTo errore
    If LngNum > 0 And LngNum < 21 Then
        num_cento = num_venti(LngNum)
    Else
        inNum1 = Int(LngNum / 10)
        If LngNum = 21 + (10 * (inNum1 - 2)) Then
            num_cento = Strconv((21 + (2 * (inNum1 - 2))))
        Else
            StrLettera = Strconv((20 + (2 * (inNum1 - 1) - 2)))
            IntNum2 = LngNum - (inNum1 * 10)
            If IntNum2 = 0 Then
            num_cento = StrLettera
            Else
             num_cento = StrLettera & Strconv(IntNum2)
            End If
           
        End If
    End If
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "num_cento"
    
End Function
'funzione mille
Private Function num_mille(LngNum As Long)
    Dim IntNum1 As Integer
    Dim IntNum2 As Integer
    Dim StrLettera As String
    On Error GoTo errore
    If LngNum = 100 Then
        num_mille = Strconv(36)
    ElseIf LngNum > 100 And LngNum < 200 Then
        IntNum1 = LngNum - 100
        StrLettera = Strconv(36)
        num_mille = StrLettera & num_cento(CLng(IntNum1))
    ElseIf LngNum >= 200 And LngNum < 1000 Then
        IntNum1 = Int(LngNum / 100)
        StrLettera = Strconv(IntNum1) & Strconv(36)
        IntNum2 = LngNum - (IntNum1 * 100)
        If LngNum <> 100 * IntNum1 Then
            num_mille = StrLettera & num_cento(CLng(IntNum2))
        Else
            num_mille = StrLettera
        End If
    End If
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "Num_mille"
End Function
'funzione che converto il testo dei centomila
Private Function num_centomila(LngNum As Long, flag As Boolean)
    Dim IntNum1 As Integer
    Dim lngNum2 As Long
    Dim StrLettera As String
    StrLettera = "mila"
    On Error GoTo errore
    IntNum1 = Int(LngNum / 1000)
    If IntNum1 = 1 And LngNum = 1000 Then
        If flag = 0 Then
            StrLettera = Strconv(37)
        Else
            StrLettera = Strconv(1)
            StrLettera = StrLettera & Strconv(38)
    
        End If
    ElseIf IntNum1 = 1 And LngNum <> 1000 Then
        If flag = 0 Then
            StrLettera = Strconv(37)
        Else
            StrLettera = Strconv(1)
            StrLettera = StrLettera & Strconv(38)
        End If
        lngNum2 = LngNum - 1000
        If lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(lngNum2)
        Else
            StrLettera = StrLettera & num_mille(lngNum2)
        End If
    
    ElseIf IntNum1 > 1 And IntNum1 <= 21 Then
        StrLettera = Strconv(IntNum1)
        StrLettera = StrLettera & Strconv(38)
        lngNum2 = LngNum - (IntNum1 * 1000)
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(lngNum2)
        ElseIf lngNum2 >= 100 Then
            StrLettera = StrLettera & num_mille(lngNum2)
        End If
    ElseIf IntNum1 > 21 And IntNum1 < 100 Then
        StrLettera = num_cento(CLng(IntNum1))
        StrLettera = StrLettera & Strconv(38)
        lngNum2 = LngNum - (CLng(IntNum1) * 1000)
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(lngNum2)
        ElseIf lngNum2 >= 100 Then
            StrLettera = StrLettera & num_mille(lngNum2)
        End If
    End If
    num_centomila = StrLettera
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "Num_centomila"
End Function

'funzione concerti in milioni
Private Function num_milione(LngNum As Long)
On Error GoTo errore
    Dim IntNum1 As Integer
    Dim lngNum2 As Long
    Dim StrLettera As String
    
    IntNum1 = Int(LngNum / 100000)
    If IntNum1 = 1 And LngNum = 100000 Then
        StrLettera = Strconv(43)
    ElseIf IntNum1 = 1 And LngNum <> 100000 Then
        StrLettera = Strconv(36)
        lngNum2 = LngNum - 100000
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & Strconv(38)
            StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
            StrLettera = StrLettera & Strconv(38)
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        Else
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        End If
    ElseIf IntNum1 > 1 Then
        StrLettera = Strconv(IntNum1)
        StrLettera = StrLettera & Strconv(36)
        lngNum2 = LngNum - (100000 * IntNum1)
        If lngNum2 > 0 And lngNum2 < 22 Then
            StrLettera = StrLettera & Strconv(38)
            StrLettera = StrLettera & num_venti(CLng(lngNum2))
        ElseIf lngNum2 >= 22 And lngNum2 < 1000 Then
            StrLettera = StrLettera & Strconv(38)
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        Else
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        End If
    End If
    num_milione = StrLettera
    Exit Function
    
errore:
    MsgBox Err.Description, vbInformation, "Num_milione"
End Function
'Funzione che converti gli importi sotto al 999.999.999
Private Function num_miliardo(LngNum As Long)
    Dim IntNum1 As Integer
    Dim lngNum2 As Long
    Dim StrLettera As String
    On Error GoTo errore
    IntNum1 = Int(LngNum / 1000000)
    If IntNum1 = 1 And LngNum = 1000000 Then
        StrLettera = "un" & Strconv(39)
    ElseIf IntNum1 = 1 And LngNum <> 1000000 Then
        StrLettera = "un" & Strconv(39)
        lngNum2 = LngNum - 1000000
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
            'nuova modifica
        ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        Else
             StrLettera = StrLettera & num_milione(CLng(lngNum2))
        End If
    ElseIf IntNum1 > 1 Then
        If IntNum1 > 21 And IntNum1 < 100 Then
            StrLettera = num_cento(CLng(IntNum1))
        ElseIf IntNum1 >= 100 And IntNum1 < 1000 Then
            StrLettera = num_mille(CLng(IntNum1))
        Else
            StrLettera = Strconv(CLng(IntNum1))
        End If
            StrLettera = StrLettera & Strconv(40)
            lngNum2 = LngNum - (1000000 * IntNum1)
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        Else
            StrLettera = StrLettera & num_milione(CLng(lngNum2))
        End If
    End If
    num_miliardo = StrLettera
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "Num_miliardo"
End Function

'Converte gli importi sotto i 999.999.999.999
Private Function num_miliardi(LngNum As Currency)
    Dim IntNum1 As Integer
    Dim lngNum2 As Long
    'variabile per il calcolo della differnza
    Dim CrrTemporaneo As Currency
    
    Dim StrLettera As String
    On Error GoTo errore
    IntNum1 = Int(LngNum / 1000000000)
    If IntNum1 = 1 And LngNum = 1000000000 Then
        StrLettera = "un" & Strconv(41)
    ElseIf IntNum1 = 1 And LngNum <> 1000000000 Then
        StrLettera = "un" & Strconv(41)
        lngNum2 = LngNum - 1000000000
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        ElseIf lngNum2 >= 100000 And lngNum2 < 1000000000 Then
            StrLettera = StrLettera & num_miliardo(lngNum2)
        Else
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        End If
    ElseIf IntNum1 > 1 Then
        If IntNum1 > 21 And IntNum1 < 100 Then
            StrLettera = num_cento(CLng(IntNum1))
        ElseIf IntNum1 >= 100 And IntNum1 < 1000 Then
            StrLettera = num_mille(CLng(IntNum1))
        Else
            StrLettera = Strconv(CLng(IntNum1))
        End If
            StrLettera = StrLettera & Strconv(42)
            'lo valorizzo con il valore di un miliardo
            CrrTemporaneo = 1000000000
            CrrTemporaneo = CrrTemporaneo * IntNum1
            
            lngNum2 = LngNum - CrrTemporaneo
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        ElseIf lngNum2 >= 100000 And lngNum2 < 1000000000 Then
            StrLettera = StrLettera & num_miliardo(lngNum2)
        Else
            StrLettera = StrLettera & num_milione(CLng(lngNum2))
        End If
    End If
    num_miliardi = StrLettera
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "Num_miliardi"
End Function

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[scossaPartecipante scossa Karma: 37 pts]

vecchio frac ha scritto:

Sul suo famoso sito e90e50 (che non trovo più) l'aveva pubblicata.

Il mitico r (Roberto Mensa)! Ho avuto l'onore di essere stato inserito da lui tra i personaggi delle Guerre Stellari in mpioe

Comunque puoi ritrovare tutte le sue pagine Web a questo link: E90E50 .

Qui la pagina del  VBA dove trovi anche le funzioni 

Convertire numeri da lettere a cifre ("undici" -> 11)
Convertire numero da cifre a lettere (11 -> "undici")

Toglimi una curiosità, il Francesco che cita sei tu?

Capitai più avanti sul blog di Francesco Cadin mentre cercavo informazioni sul valuta.testo di Excel e girando per il suo blog mi accorsi che non ero il solo *matto* al mondo 🙂
 

 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

scossa ha scritto:

Il mitico r (Roberto Mensa)! Ho avuto l'onore di essere stato inserito da lui tra i personaggi delle Guerre Stellari in mpioe

Eh lo so. E' da lì che anch'io ho fatto la tua conoscenza   
Grazie che mi hai ritrovato il sito! almeno quello c'è ancora. I miei pezzi mi crollano addosso   

scossa ha scritto:

Toglimi una curiosità, il Francesco che cita sei tu?

Ho avuto anch'io l'onore di essere stato considerato da nick r infatti.
Purtroppo quel blog non esiste più, travolto dal triste destino di VBT&T.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

albatros54 ha scritto:

Forse è questa

Mi dispiace Gioacchino... non è la mia versione.

[albatros54Moderatore albatros54 Karma: 89 pts]

Tips and Ticks  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Tips and Ticks  

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Ecco questo sulle date è interessante. Le date sono sempre fonte di problemi e non solo in VBA.

[Autore]

Articoli