Creare ricevuta generica da foglio excel

[tommy95]

Ciao a tutti,
avrei la necessità di creare una "ricevuta generica" partendo da un elenco di nominativi (nominativo, codice fiscale, indirizzo...) presente in un foglio excel.
Ho trovato discussioni simili di anni passati, ma gli allegati non sono più disponibili per il download.
Qualcuno può aiutarmi?
Lo stile della ricevuta potrebbe essere un qualcosa tipo la foto sotto.
Grazie in anticipo

[Anthony47]

Creati un foglio in cui nelle colonne di sinistra scriverai i dati sintetici della ricevuta che vuoi poi stampare
Sulla destra del foglio creati la ricevuta che vuoi stampare; i valori da inserire in ricevuta li prenderai con formula dalle colonne di sinistra.
Per ottenere la scritta in lettere del valore userai la Function di cui ti diro’ tra poco
Scegli a piacere tuo il layour Orizzontale o Verticale, quante ricevute vuoi stampare per foglio, se vuoi stampare anche una copia per te (o ti bastano i dati sintetici delle colonne di sinistra), l’importante e’ che il risultato stia in un foglio A4 (o la dimensione standard della tua stampante)
Imposta l’area “l’area di stampa” di Excel pari all’area occupata dalle ricevute

Nell’area di sinistra predisponi tante righe quante sono le ricevute che hai inserito in un foglio A4

Quando vuoi stampare delle ricevute, compila l’area di sinistra; le formule che hai inserito riporteranno nelle rivute i valori nel formato che ti serve; quando sei pronto usa il comando Stampa che stampera’ il foglio A4 nel formato che hai predisposto.

Per riportare il valore della ricevuta anche in lettere puoi usare la seguente Funzione:

Codice: Seleziona tutto

Option Base 1        'RIGOROSAMENTE IN TESTA AL MODULO
Dim sSpell As String 'SEMPRE IN TESTA AL MODULO
Function SpellItV2(ByVal myValore As Double, Optional ByVal myDec As Integer = 2) As String
'traduce un valore nel suo spelling, by Anthony47
'
'Uso:
'      =SPELLITv2(ValoreNumerico [;NumDecimali])
'               NumDecimali e' opzionale, di default viene usato 2
'
'Esempio
'=SPELLITv2(456,789) restituira' "quattrocentocinquantasei/79"
'
'Max ValNumerico = 2.147.483.647
'I Negativi vengono rappresentati come "-(Spelling)"
'
Dim sValore As String, sPotenza, uPotenza, I As Long, myMille As String, vValore As Long
'
sSpell = ""
'Valori chiave e sostituzioni
sPotenza = Array("miliardi.", "milioni.", "mila.", "")
uPotenza = Array("unmiliardo.", "unmilione.", "mille.", "")
'
sValore = Format(Abs(Fix(myValore)), "000000000000")
vValore = Int(Abs(myValore))
'
For I = 1 To 4   '4 blocchi "migliaia"
myMille = Mid(sValore, 1 + (I - 1) * 3, 3)
If CLng(myMille) > 0 Then
    If CLng(myMille) = 1 Then
        If I = 4 Then
            sSpell = sSpell & "uno"    'uPotenza(I)
        Else
            sSpell = sSpell & uPotenza(I)
        End If
    Else
        sSpell = sSpell & sMille(myMille) & sPotenza(I)
    End If
End If
Next I
'Compila spelling
If sSpell = "" Then sSpell = "zero"
If myDec > 0 Then myVirg = "/" & Format(Round((Abs(myValore) - vValore) * (10 ^ myDec), 0), String(myDec, "0"))
SpellItV2 = sSpell & myVirg
If myValore < 0 Then SpellItV2 = "-(" & SpellItV2 & ")"
End Function

Function sMille(ByVal sBlocco As String) As String
Dim vNum, sNum, vBlocco As Long, nwBlocco As String, strNum As String
Dim Iv As Long
'
'Valori chiave
vNum = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
    30, 40, 50, 60, 70, 80, 90, 100)
sNum = Array("", "uno", "due", "tre", "quattro", "cinque", "sei", "sette", "otto", "nove", "dieci", "undici", _
    "dodici", "tredici", "quattordici", "quindici", "sedici", "diciassette", "diciotto", "diciannove", "venti", _
    "trenta", "quaranta", "cinquanta", "sessanta", "settanta", "ottanta", "novanta", "cento")
If Len(sBlocco) > 3 Then   'Sara' sempre Falso
    sMille = "#####": Exit Function
End If
'
strNum = sBlocco
ReBlk:
vBlocco = CLng(strNum)
If vBlocco > 99 Then
    nwBlocco = Left(strNum, 1)
    If vBlocco > 199 Then
        txt1 = sMille(nwBlocco) & "cento"
        strNum = Replace(strNum, nwBlocco, "", 1, 1)
    Else
        txt1 = "cento"
        strNum = Replace(strNum, nwBlocco, "", 1, 1)
    End If
End If
If vBlocco > 199 Then GoTo ReBlk
If vBlocco <= 20 Then GoTo Fase3
Fase2:
vBlocco = CLng(strNum)
    CPart = Application.Match(vBlocco, vNum)
    txt2 = sNum(CPart)
    CVal = vNum(CPart)
    vBlocco = vBlocco - CVal
Fase3:
If vBlocco > 0 Then
    txt3 = sNum(vBlocco + 1)
'    txt3 = sMille(Format(vBlocco, "0"))
End If
'
'Compila spelling
If (Left(txt3, 1) = "u" Or Left(txt3, 1) = "o") And Len(txt2) > 0 Then _
    txt2 = Left(txt2, Len(txt2) - 1)
sMille = txt1 & txt2 & txt3
End Function


Copia il codice in un modulo standard inizialmente vuoto del vba, im modo che Option Base 1 sia in testa al modulo
Poi sul foglio excel puoi usare la formula =SpellItV2(IlValore)

Un esempio:


In H3 la formula usata e’ =SpellItV2(K2)

Partendo da questa base si potranno poi apportare piccole modifiche; es avviare la stampa con macro che si occupa di copiare le colonne di sintesi in un elenco di ricevute emesse. Ma di questo parleremo eventualmente quando la tua “base” e’ pronta.