Correggere l'errore #NOME? in una cella che contiene una formula.

Anonimo

Buongiorno a tutti.

Ho utilizzato questa funzione, trovata in rete per convertire un numero in lettere.

Option Explicit
Private Function Unita(ByVal k As Integer) As String
Dim Lettere() As String
Lettere = Split(",uno,due,tre,quattro,cinque,sei,sette,otto,nove,dieci,undici,dodici,tredici,quattordici,quindici,sedici,diciassette,diciotto,diciannove", ",")
If (k < 0) Or (k > UBound(Lettere)) Then
Unita = ""
Else
Unita = Lettere(k)
End If
End Function

Private Function Decine(ByVal k As Integer) As String
Dim Lettere() As String
Lettere = Split(",dieci,venti,trenta,quaranta,cinquanta,sessanta,settanta,ottanta,novanta", ",")
If (k < 0) Or (k > UBound(Lettere)) Then
Decine = ""
Else
Decine = Lettere(k)
End If
End Function

Private Function Migliaia(ByVal k As Integer) As String
Dim Lettere() As String
Lettere = Split(",mille,unmilione,unmiliardo,millemiliardi,mila,milioni,miliardi,milamiliardi,milamiliardi,migliaiadimiliardi", ",")
If (k < 0) Or (k > UBound(Lettere)) Then
Migliaia = ""
Else
Migliaia = Lettere(k)
End If
End Function

Private Function CalcolaLettere(ByVal Importo As Currency) As String
Dim result As String
result = ""
Dim intero As String
intero = Format(Importo, "0.00")
Dim resto As String
resto = "/" + Right(intero, 2)
intero = Left(intero, Len(intero) - 3)
If Left(intero, 1) = "-" Then
intero = Mid(intero, 2)
End If
If Importo = 0 Then
CalcolaLettere = "zero/00"
Exit Function
End If
Dim mille As Integer
mille = -1
Dim k As Integer
k = Len(intero) Mod 3
If Not (k = 0) Then
intero = String(3 - k, "0") + intero
End If
While Not (intero = "")
mille = mille + 1
Dim parziale As String
parziale = ""
Dim tripla As String
tripla = Right(intero, 3)
Dim s As String
s = ""
intero = Left(intero, Len(intero) - 3)
Dim tv As Integer
tv = CInt(tripla)
Dim td As Integer
td = tv Mod 100
Dim tc As Integer
tc = (tv - td) / 100
If Not (tc = 0) Then
parziale = "cento"
If tc > 1 Then
parziale = Unita(tc) + parziale
End If
End If
If td < 20 Then
parziale = parziale + Unita(td)
Else
Dim x As Integer
x = td Mod 10
Dim y As Integer
y = (td - x) / 10
parziale = parziale + Decine(y)
s = Unita(x)
If (InStr(1, "uo", Left(s, 1)) <> 0) And (s <> "") And (Not (y = 0)) Then
parziale = Left(parziale, Len(parziale) - 1)
End If
parziale = parziale + s
End If
s = Migliaia(mille)
If (mille > 0) And (Not (parziale = "")) Then
k = mille
If Not (parziale = "uno") Then
k = k + 4
s = Migliaia(k)
If Right(parziale, 3) = "uno" Then
parziale = Left(parziale, Len(parziale) - 1)
End If
Else
parziale = ""
End If
parziale = parziale + s
End If
result = parziale + result
Wend
If Importo < 0 Then
result = "meno" + result
End If
CalcolaLettere = result + resto
End Function
Public Function Cifre2Lettere(ByVal Importo As Currency) As String
Cifre2Lettere = CalcolaLettere(Importo)
End Function

L'ho richiamata nella cella E11 in questo modo.

=SE(D11="";"";Cifre2Lettere(D11)) e sembra funzionare bene.

Il problema che riscontro è quello rappresentato nell'immagine allegata, che si verifica quando salvo il file con estensione xslm in formato xlsx ( cioè senza macro e codice vba).

Come faccio a risolvere questo problema?

Cioè visualizzare correttamente il valore convertito in lettere come da seguente immagine.

Ringrazio in anticipo chi mi aiuta in questo.

Ciao, Nicola.

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Ciao Nicola,

Buongiorno a tutti, ciao Norman.

Nonostante avessi sostituito le righe che tu mi hai suggerito, il problema non si risolve nel file esportato in formato xlsx.

Ho preferito inviartelo sulla tua posta personale poiché contiene dati sensibili, parecchio codice vba e formule.

Questo è il codice che definitivo, con il tuo ultimo suggerimento:

Public Sub Copia_Foglio_Domanda()

    Dim FileExtStr As String

    Dim FileFormatNum As Long

    Dim SourceWB As Workbook

    Dim destWB As Workbook

    Dim TempFilePath As String

    Dim TempFileName As String

    Dim i As Long

    Dim oleObj As OLEObject

    Const sPassword As String = "abc"              '<<=== Modifica

    With Application

        .ScreenUpdating = False

        .EnableEvents = False

    End With

    Set SourceWB = ActiveWorkbook

    Sheets("Foglio1").Copy

    With ActiveSheet

        .Unprotect Password:=sPassword

        For Each oleObj In .OLEObjects

            If TypeName(oleObj.Object) = "CommandButton" Then

                oleObj.Delete

            End If

        Next oleObj

        .UsedRange.Value = .UsedRange.Value

        .UsedRange.Locked = True

        .Protect Password:=sPassword

        '.UsedRange.Locked = True              remmate perchè devo esportare solo i dati e non le formule

        '.Protect Password:=sPassword

     End With

    Set destWB = ActiveWorkbook

    TempFilePath = SourceWB.Path & ""

    TempFileName = Sheets("Foglio1").Range("B3").Value & " " & Sheets("Foglio1").Range("B5").Value & _
                   Sheets("Foglio1").Range("D3").Value & "_" & Format(Now, "dd-mmm-yy h-mm-ss")

    With destWB

       Application.DisplayAlerts = False

        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                 FileFormat:=51

              Application.DisplayAlerts = True

     '   On Error Resume Next

     '   For i = 1 To 3

     '      .SendMail "", _

                      '""

            'If Err.Number = 0 Then Exit For

    '    Next i

    '     On Error GoTo 0

        .Close SaveChanges:=True


    End With

Call Elimina_File
       'Kill TempFilePath & TempFileName & ".xlsx"

     With Application

        .ScreenUpdating = True

        .EnableEvents = True

    End With

End Sub

e l'errore è sempre lo stesso, vedi immagine del file xlsx creato:

Grazie per la tua immensa disponibilità

Ho ricevuto il tuo file e ho capito il problema,

Prova a sostituire la procedura Copia_Foglio_Domanda con la seguente versione:

'========>>

Public Sub Copia_Foglio_Domanda()

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim SourceWB As Workbook

Dim destWB As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim i As Long

Dim oleObj As OLEObject

Const sPassword As String = "abc" '<<=== Modifica

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

Set SourceWB = ActiveWorkbook

With SourceWB.Sheets("Foglio1")

.UsedRange.Value = .UsedRange.Value

.Copy

End With

With ActiveSheet

.Unprotect Password:=sPassword

For Each oleObj In .OLEObjects

If TypeName(oleObj.Object) = "CommandButton" Then

oleObj.Delete

End If

Next oleObj

.UsedRange.Locked = True

.Protect Password:=sPassword

End With

Set destWB = ActiveWorkbook

TempFilePath = SourceWB.Path & ""

TempFileName = Sheets("Foglio1").Range("B3").Value & " " _

& Sheets("Foglio1").Range("B5").Value & _

Sheets("Foglio1").Range("D3").Value & "_" _

& Format(Now, "dd-mmm-yy h-mm-ss")

With destWB

Application.DisplayAlerts = False

.SaveAs TempFilePath & TempFileName & FileExtStr, _

FileFormat:=51

Application.DisplayAlerts = True

' On Error Resume Next

' For i = 1 To 3

' .SendMail "", _

'""

'If Err.Number = 0 Then Exit For

' Next i

' On Error GoTo 0

.Close SaveChanges:=True

End With

Call Elimina_File

'Kill TempFilePath & TempFileName & ".xlsx"

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

'<<========

===

Regards,

Norman

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Ciao Nicola,

Ciao Norman, grazie. Nel foglio xlsx che viene creato con il tuo codice, non è opportuno che vengano mantenute le formule ma solo ed esclusivamente i dati. Come tu dici in questo caso i valori statici.

Nella procedura Copia_Foglio_Domanda, per convertire le formule in valori ststici, sostituisci

.UsedRange.Locked = True

.Protect Password:=sPassword

con:

.UsedRange.Value = .UsedRange.Value

.UsedRange.Locked = True

.Protect Password:=sPassword

===

Regards,

Norman

0 commenti

12 risposte aggiuntive

Anonimo

2021-01-26T16:36:24+00:00

Ciao Nicola,

Ciao Norman, grazie come sempre per il tuo puntuale riscontro.

Sinceramente non ho inteso bene cosa mi suggerisci.

Il file Xlsx lo creo con una tua precedente routine, che posto.

Public Sub Copia_Foglio_Domanda()

    Dim FileExtStr As String

    Dim FileFormatNum As Long

    Dim SourceWB As Workbook

    Dim destWB As Workbook

    Dim TempFilePath As String

    Dim TempFileName As String

    Dim i As Long

    Dim oleObj As OLEObject

    Const sPassword As String = "abc"              '<<=== Modifica

    With Application

        .ScreenUpdating = False

        .EnableEvents = False

    End With

    Set SourceWB = ActiveWorkbook

    Sheets("Foglio1").Copy

    With ActiveSheet

        .Unprotect Password:=sPassword

        For Each oleObj In .OLEObjects

            If TypeName(oleObj.Object) = "CommandButton" Then

                oleObj.Delete

            End If

        Next oleObj

        .UsedRange.Locked = True

        .Protect Password:=sPassword

     End With

    Set destWB = ActiveWorkbook

    TempFilePath = SourceWB.Path & ""

    TempFileName = Sheets("Foglio1").Range("B3").Value & " " & Sheets("Foglio1").Range("B5").Value & _
                   Sheets("Foglio1").Range("D3").Value & "_" & Format(Now, "dd-mmm-yy h-mm-ss")

    With destWB

       Application.DisplayAlerts = False

        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                 FileFormat:=51

              Application.DisplayAlerts = True

     '   On Error Resume Next

     '   For i = 1 To 3

     '      .SendMail "", _

                      '""

            'If Err.Number = 0 Then Exit For

    '    Next i

    '     On Error GoTo 0

        .Close SaveChanges:=True


    End With

Call Elimina_File
       'Kill TempFilePath & TempFileName & ".xlsx"

     With Application

        .ScreenUpdating = True

        .EnableEvents = True

    End With

End Sub

Public Sub Elimina_File()
On Error GoTo ErrorHandler
If ActiveWorkbook.Path <> "" Then
If Not ActiveWorkbook.ReadOnly Then
ActiveWorkbook.Saved = True
ActiveWorkbook.ChangeFileAccess xlReadOnly
End If
Kill ActiveWorkbook.FullName
Application.ActiveWorkbook.Close False
End If
Exit Sub

ErrorHandler:
MsgBox "Il File: " & ActiveWorkbook.FullName & " Non è stato eliminato, qualcosa non ha funzionato!!", vbCritical
Exit Sub

End Sub

Quindi non saprei come risolvere questo problema utilizzando la funzione e le tue 2 routine precedentei.

Grazie mille per la spiegazione che vorrai fornirmi affinché io capisca come risolvere quell'errore.

Nella nuova cartella di lavoro che viene creata dal mio codice precedente, è necessario mantenere le formule o posso modificare il codice per convertire tutte le formule in valori statici ?

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2021-01-26T15:42:57+00:00

Ciao Norman, grazie come sempre per il tuo puntuale riscontro.

Sinceramente non ho inteso bene cosa mi suggerisci.

Il file Xlsx lo creo con una tua precedente routine, che posto.

Public Sub Copia_Foglio_Domanda()

    Dim FileExtStr As String

    Dim FileFormatNum As Long

    Dim SourceWB As Workbook

    Dim destWB As Workbook

    Dim TempFilePath As String

    Dim TempFileName As String

    Dim i As Long

    Dim oleObj As OLEObject

    Const sPassword As String = "abc"              '<<=== Modifica

    With Application

        .ScreenUpdating = False

        .EnableEvents = False

    End With

    Set SourceWB = ActiveWorkbook

    Sheets("Foglio1").Copy

    With ActiveSheet

        .Unprotect Password:=sPassword

        For Each oleObj In .OLEObjects

            If TypeName(oleObj.Object) = "CommandButton" Then

                oleObj.Delete

            End If

        Next oleObj

        .UsedRange.Locked = True

        .Protect Password:=sPassword

     End With

    Set destWB = ActiveWorkbook

    TempFilePath = SourceWB.Path & ""

    TempFileName = Sheets("Foglio1").Range("B3").Value & " " & Sheets("Foglio1").Range("B5").Value & _
                   Sheets("Foglio1").Range("D3").Value & "_" & Format(Now, "dd-mmm-yy h-mm-ss")

    With destWB

       Application.DisplayAlerts = False

        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                 FileFormat:=51

              Application.DisplayAlerts = True

     '   On Error Resume Next

     '   For i = 1 To 3

     '      .SendMail "", _

                      '""

            'If Err.Number = 0 Then Exit For

    '    Next i

    '     On Error GoTo 0

        .Close SaveChanges:=True

    End With

Call Elimina_File
       'Kill TempFilePath & TempFileName & ".xlsx"

     With Application

        .ScreenUpdating = True

        .EnableEvents = True

    End With

End Sub

Public Sub Elimina_File()
On Error GoTo ErrorHandler
If ActiveWorkbook.Path <> "" Then
If Not ActiveWorkbook.ReadOnly Then
ActiveWorkbook.Saved = True
ActiveWorkbook.ChangeFileAccess xlReadOnly
End If
Kill ActiveWorkbook.FullName
Application.ActiveWorkbook.Close False
End If
Exit Sub

ErrorHandler:
MsgBox "Il File: " & ActiveWorkbook.FullName & " Non è stato eliminato, qualcosa non ha funzionato!!", vbCritical
Exit Sub

End Sub

Quindi non saprei come risolvere questo problema utilizzando la funzione e le tue 2 routine precedentei.

Grazie mille per la spiegazione che vorrai fornirmi affinché io capisca come risolvere quell'errore.

Ciao,Nicola.
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2021-01-26T13:47:11+00:00

Ciao Nicola,

Ho utilizzato questa funzione, trovata in rete per convertire un numero in lettere.

Option Explicit
Private Function Unita(ByVal k As Integer) As String
Dim Lettere() As String
Lettere = Split(",uno,due,tre,quattro,cinque,sei,sette,otto,nove,dieci,undici,dodici,tredici,quattordici,quindici,sedici,diciassette,diciotto,diciannove", ",")
If (k < 0) Or (k > UBound(Lettere)) Then
Unita = ""
Else
Unita = Lettere(k)
End If
End Function

Private Function Decine(ByVal k As Integer) As String
Dim Lettere() As String
Lettere = Split(",dieci,venti,trenta,quaranta,cinquanta,sessanta,settanta,ottanta,novanta", ",")
If (k < 0) Or (k > UBound(Lettere)) Then
Decine = ""
Else
Decine = Lettere(k)
End If
End Function

Private Function Migliaia(ByVal k As Integer) As String
Dim Lettere() As String
Lettere = Split(",mille,unmilione,unmiliardo,millemiliardi,mila,milioni,miliardi,milamiliardi,milamiliardi,migliaiadimiliardi", ",")
If (k < 0) Or (k > UBound(Lettere)) Then
Migliaia = ""
Else
Migliaia = Lettere(k)
End If
End Function

Private Function CalcolaLettere(ByVal Importo As Currency) As String
Dim result As String
result = ""
Dim intero As String
intero = Format(Importo, "0.00")
Dim resto As String
resto = "/" + Right(intero, 2)
intero = Left(intero, Len(intero) - 3)
If Left(intero, 1) = "-" Then
intero = Mid(intero, 2)
End If
If Importo = 0 Then
CalcolaLettere = "zero/00"
Exit Function
End If
Dim mille As Integer
mille = -1
Dim k As Integer
k = Len(intero) Mod 3
If Not (k = 0) Then
intero = String(3 - k, "0") + intero
End If
While Not (intero = "")
mille = mille + 1
Dim parziale As String
parziale = ""
Dim tripla As String
tripla = Right(intero, 3)
Dim s As String
s = ""
intero = Left(intero, Len(intero) - 3)
Dim tv As Integer
tv = CInt(tripla)
Dim td As Integer
td = tv Mod 100
Dim tc As Integer
tc = (tv - td) / 100
If Not (tc = 0) Then
parziale = "cento"
If tc > 1 Then
parziale = Unita(tc) + parziale
End If
End If
If td < 20 Then
parziale = parziale + Unita(td)
Else
Dim x As Integer
x = td Mod 10
Dim y As Integer
y = (td - x) / 10
parziale = parziale + Decine(y)
s = Unita(x)
If (InStr(1, "uo", Left(s, 1)) <> 0) And (s <> "") And (Not (y = 0)) Then
parziale = Left(parziale, Len(parziale) - 1)
End If
parziale = parziale + s
End If
s = Migliaia(mille)
If (mille > 0) And (Not (parziale = "")) Then
k = mille
If Not (parziale = "uno") Then
k = k + 4
s = Migliaia(k)
If Right(parziale, 3) = "uno" Then
parziale = Left(parziale, Len(parziale) - 1)
End If
Else
parziale = ""
End If
parziale = parziale + s
End If
result = parziale + result
Wend
If Importo < 0 Then
result = "meno" + result
End If
CalcolaLettere = result + resto
End Function
Public Function Cifre2Lettere(ByVal Importo As Currency) As String
Cifre2Lettere = CalcolaLettere(Importo)
End Function

L'ho richiamata nella cella E11 in questo modo.

=SE(D11="";"";Cifre2Lettere(D11)) e sembra funzionare bene.

Il problema che riscontro è quello rappresentato nell'immagine allegata, che si verifica quando salvo il file con estensione xslm in formato xlsx ( cioè senza macro e codice vba).

Come faccio a risolvere questo problema?

Cioè visualizzare correttamente il valore convertito in lettere come da seguente immagine.

Se salvi il file senza macro e codice VBA, la funzione Cifre2Lettere non verrà riconosciuta e verrà restituito l'errore #NOME?.

Se desideri salvare il file senza alcun codice, per continuare a utilizzare la funzione Cifre2Lettere, dovrai salvare il tuo codice in un Addin o nel tuo Personal.xlsm

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento