Textbox Userfom che riporta valore cella di un foglio specifico con valuta

[vecchio fracSenior Moderator vecchio frac Karma: 253 pts]

Ho spulciato la discussione e ho trovato una versione precedente che avevi allegato all'inizio, non credo che sia variato molto lo scenario, e quindi ho riscontrato quello che dici nell'ultimo post.

Allora, semplicemente, per utilizzare Find ti serve una variabile di tipo Range alla quale assegni (essendo un oggetto si usa Set) il risultato del metodo Find. Se la ricerca è negativa il risultato è Nothing, altrimenti è la cella che contiene il valore cercato. Da qui è facile capire che  se la ricerca avviene in colonna B, da sinistra (colonna A) recuperi il tipo, da destra (colonna C) l'importo. Valori che poi infili nelle tue textbox.

Private Sub btnInserisci2_Click()
Dim f As Range

    Set f = Worksheets("Fatture").Range("B:B").Find(cboCerca, lookat:=xlWhole)
    If f Is Nothing Then MsgBox "Not found": Exit Sub

    cboTipo = f.Offset(, -1)
    txtNfattura = f
    txtImporto = f.Offset(, 1)

    cboCerca.Clear
    cboCerca.RowSource = Range("B2:B" & [COUNTA(B:B)])
    
End Sub

[Dandelion1987Partecipante Dandelion1987]

Ciao!

Ti ringrazio innazitutto per la risposta 🙂

Ho provato il codice ma non riesco a farlo funzionare.

Ti allego il file aggiornato con tutte le modifiche effettuate prima dell'inserimento del tuo codice.

In sostanza quando inserisco una fattura mi appare in questo modo su cboCerca:

E se la seleziono vorrei che nelle textbox Tipo, N. Fattura e Importo apparissero i valori delle rispettive tre celle.

Invece ora rimangono vuote:

Ps: Non badare alla voce "saldo ft." in quanto ho messo apposta che quella textbox non si cancelli anche una volta inseriti i dati, in modo da rendere più veloce la registrazione delle fatture.

Il codice attuale è il seguente:

Private Sub btnInserisci2_Click()
Dim numriga As Long

numriga = 2
Do Until Sheets("Fatture").Cells(numriga, 2) = ""
    If Sheets("Fatture").Cells(numriga, 2) = cboCerca.Text Then Exit Do
    numriga = numriga + 1
Loop

Foglio3.Cells(numriga, 1) = cboTipo.Text
Foglio3.Cells(numriga, 2) = txtNfattura.Text
Foglio3.Cells(numriga, 3) = Val(TextBox8.Text) * 1

numriga = Sheets("Totale").Range("A1").CurrentRegion.Rows.Count
numriga = numriga + 0
Foglio4.Cells(numriga, 2) = TextBox6.Text

txtNfattura.Text = ""
TextBox8.Text = ""
txtNfattura.SetFocus

TextBox7.Value = Sheets("Totale").Range("A2").Value
TextBox5.Value = Sheets("Totale").Range("C2").Value
TextBox6.Value = Sheets("Totale").Range("B2").Value
cboSportello.Value = Sheets("Cliente").Range("A2").Value
txtUtenza.Value = Sheets("Cliente").Range("B2").Value
txtNome.Value = Sheets("Cliente").Range("C2").Value
cboOperazione.Value = Sheets("Cliente").Range("D2").Value
cboMezzo.Value = Sheets("Cliente").Range("E2").Value

TextBox5 = Format(TextBox5, "#,###0.#0 €")
TextBox6 = Format(TextBox6, "#,###0.#0 €")
TextBox7 = Format(TextBox7, "#,###0.#0 €")

'--------------------------------------------------------------------
'-------------------MODIFICA--------------------------------
'--------------------------------------------------------------------
cboCerca.Clear
For h = 2 To 11
    With Me.cboCerca
        .AddItem Sheets("Fatture").Range("b" & h)
    End With
Next h
'--------------------------------------------------------------------

MsgBox ("Inserimento eseguito con successo!")
End Sub

Spero che anche questa volta con il tuo aiuto prezioso di risolvere 😀

Grazie mille!

Allegati:

You must be logged in to view attached files.

[Dandelion1987Partecipante Dandelion1987]

Ok ho risolto insistendo con questo codice:

Private Sub cboCerca_Click()
txtNfattura = cboCerca
Dim r As Range
Set r = Worksheets("Fatture").Columns(2).Find(cboCerca)
cboTipo = r.Offset(0, -1)
txtNfattura = r.Offset(0, 0)
TextBox8 = r.Offset(0, 1)
End Sub

Ora il file è ultimato, però ho notato che da un'altro PC mi da errore debug relativo alla creazione del pdf e invio mail.

Il codice è questo:

Sub Invia()
    
' --> User settings, change to suit
    Const IsDisplay As Boolean = True           ' Change to False to .Send instead of .Display
    Const IsSilent As Boolean = False           ' Change to True to Send without the confirmation MsgBox
' <-- End of settings
    
    Dim IsCreated As Boolean
    Dim i As Long
    Dim PdfFile As String
    Dim OutlApp As Object
    Dim char As Variant
    
'
' Define PDF filename
    PdfFile = Range("C15").Value '===============>> CELLA CONTENENTE IL MESE
    
' Replace unallowed symbols by the underscore char
    For Each char In Split("? "" / \ < > * | :")
        PdfFile = Replace(PdfFile, char, ".")
    Next
' Add %TEMP% path to the file name and limit too long pathname
    PdfFile = Left(Environ("TEMP") & "\" & PdfFile, 251) & " RICEVUTA DI PAGAMENTO.pdf"
    
' Export an active sheet as PDF
    With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=PdfFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        From:=1, To:=1, _
        OpenAfterPublish:=False
    End With
    
' Use already open Outlook if possible
    On Error Resume Next
    Set OutlApp = GetObject(, "Outlook.Application")
    If Err Then
        Set OutlApp = CreateObject("Outlook.Application")
        IsCreated = True
    End If
    On Error GoTo 0
    
' Prepare e-mail with PDF attachment
    With OutlApp.CreateItem(0)
        
' Prepare e-mail
        .Attachments.Add PdfFile
        
' Try to send or just display the e-mail
        On Error Resume Next
        If IsDisplay Then .Display Else .Send
        
' Show error of .Send method
        If Not IsDisplay Then
' Return focus to Excel's window
            Application.Visible = True
        End If
    
    End With
    
' Delete PDF file
    Kill PdfFile
    
' Quit Outlook if it was created by this code
    If IsCreated Then OutlApp.Quit
    
' Release memory of the object variable
    Set OutlApp = Nothing
    
End Sub

da cosa può dipendere?

Il percorso del file?

C'è qualcosa che devo cambiare del codice per eliminare l'errore o devo settarlo sempre in base al PC?

[vecchio fracSenior Moderator vecchio frac Karma: 253 pts]

Dandelion1987 ha scritto:

da un'altro PC mi da errore debug relativo alla creazione del pdf e invio mail.

Che tipo di errore? che messaggio ricevi? su cosa si ferma il codice?

Se è su .ExportAsFixedFormat, o non esiste la cartella di destinazione o la versione di Excel è minore della 2007.

[Dandelion1987Partecipante Dandelion1987]

Ciao!

Scusa il ritardo ma avuto una settimana un pò particolare.

Come dicevi tu dipendeva dalla versione di Excel e quindi sono riuscito a sistemare.

Ora però mi si è presentato un'altro problema che pensavo di avere risolto.

Ruguarda questo codice:

Private Sub btnInserisci2_Click()
Dim numriga As Long

numriga = 2
Do Until Sheets("Fatture").Cells(numriga, 2) = ""
    If Sheets("Fatture").Cells(numriga, 2) = cboCerca.Text Then Exit Do
    numriga = numriga + 1
Loop

Foglio3.Cells(numriga, 1) = cboTipo.Text
Foglio3.Cells(numriga, 2) = txtNfattura.Text
Foglio3.Cells(numriga, 3) = Val(TextBox8.Text) * 1

numriga = Sheets("Totale").Range("A1").CurrentRegion.Rows.Count
numriga = numriga + 0
Foglio4.Cells(numriga, 2) = TextBox6.Text

txtNfattura.Text = ""
TextBox8.Text = ""
txtNfattura.SetFocus

TextBox7.Value = Sheets("Totale").Range("A2").Value
TextBox5.Value = Sheets("Totale").Range("C2").Value
TextBox6.Value = Sheets("Totale").Range("B2").Value
cboSportello.Value = Sheets("Cliente").Range("A2").Value
txtUtenza.Value = Sheets("Cliente").Range("B2").Value
txtNome.Value = Sheets("Cliente").Range("C2").Value
cboOperazione.Value = Sheets("Cliente").Range("D2").Value
cboMezzo.Value = Sheets("Cliente").Range("E2").Value

TextBox5 = Format(TextBox5, "#,###0.#0 €")
TextBox6 = Format(TextBox6, "#,###0.#0 €")
TextBox7 = Format(TextBox7, "#,###0.#0 €")
TextBox8 = Format(TextBox7, "#,###0.#0 €")

'--------------------------------------------------------------------
'-------------------MODIFICA--------------------------------
'--------------------------------------------------------------------
cboCerca.Clear
For h = 2 To 11
    With Me.cboCerca
        .AddItem Sheets("Fatture").Range("b" & h)
    End With
Next h
'--------------------------------------------------------------------

MsgBox ("Inserimento eseguito con successo!")
End Sub

Per la precisione questa parte:

Foglio3.Cells(numriga, 3) = Val(TextBox8.Text) * 1

Essenzialmente quando mettevo un'importo come ad esempio 22,54 mi appariva 22..

Per ovviare a questo problema ho inserito questo codice e anche se dividevo con la virgola appariva corretto.

Il problema è che ora se inserisco 22,54 mi viene fuori 22,00€..

Come posso risolvere?

 

Grazie mille!

[Dandelion1987Partecipante Dandelion1987]

Ok ho risolto così:

Private Sub btnInserisci2_Click()
Dim numriga As Long

TextBox8 = Format(TextBox8, "#,###0.#0 €")

numriga = 2
Do Until Sheets("Fatture").Cells(numriga, 2) = ""
    If Sheets("Fatture").Cells(numriga, 2) = cboCerca.Text Then Exit Do
    numriga = numriga + 1
Loop

Foglio3.Cells(numriga, 1) = cboTipo.Text
Foglio3.Cells(numriga, 2) = txtNfattura.Text
Foglio3.Cells(numriga, 3) = TextBox8.Text

numriga = Sheets("Totale").Range("A1").CurrentRegion.Rows.Count
numriga = numriga + 0
Foglio4.Cells(numriga, 2) = TextBox6.Text

txtNfattura.Text = ""
TextBox8.Text = ""
txtNfattura.SetFocus

TextBox7.Value = Sheets("Totale").Range("A2").Value
TextBox5.Value = Sheets("Totale").Range("C2").Value
TextBox6.Value = Sheets("Totale").Range("B2").Value
cboSportello.Value = Sheets("Cliente").Range("A2").Value
txtUtenza.Value = Sheets("Cliente").Range("B2").Value
txtNome.Value = Sheets("Cliente").Range("C2").Value
cboOperazione.Value = Sheets("Cliente").Range("D2").Value
cboMezzo.Value = Sheets("Cliente").Range("E2").Value

TextBox5 = Format(TextBox5, "#,###0.#0 €")
TextBox6 = Format(TextBox6, "#,###0.#0 €")
TextBox7 = Format(TextBox7, "#,###0.#0 €")

cboCerca.Clear
For h = 2 To 11
    With Me.cboCerca
        .AddItem Sheets("Fatture").Range("b" & h)
    End With
Next h

MsgBox ("Inserimento eseguito con successo!")
End Sub

Adesso vorrei risolvere un'altro problema e per sicurezza allego il file completo.

Non capisco perché quando clicco sul CommandButton "btnInserisci2" mi compila solo la prima cella della colonna (Tipo) inizialmente e solo dopo aver cliccato "Ok" sul MsgBox mi compila le altre due restanti celle..

Credo dipenda da questa parte del codice..

Foglio3.Cells(numriga, 1) = cboTipo.Text
Foglio3.Cells(numriga, 2) = txtNfattura.Text
Foglio3.Cells(numriga, 3) = TextBox8.Text

Infatti se inverto e metto al primo posto txtNfattura la prima ad essere compilata è proprio quella cella e le altre sempre dopo aver cliccato il tasto Ok del MsgBox..

Ho provato in tutti i modi ma non riesco..

 

Grazie a chi mi aiuta 😀

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 253 pts]

La macro "btnInserisci2" non viene mai eseguita... al pulsante "Inserisci" sull'userform è associata la macro "btnInserisci1_Click" (perchè questo è il nome del pulsante). Cambia il nome del pulsante btnInserisci1 e chiamalo btnInserisci2 oppure elimina btnInserisci1_Click() e rinomina btnInserisci2_Click come btnInserisci1_Click.

E' solo questione di nomi giusti.

Oppure modifica il codice di btnInserisci1_Click perchè faccia le cose giuste.

[Dandelion1987Partecipante Dandelion1987]

Grazie mille come sempre 🙂

Ora provo a fare come mi hai detto.

Comunque quando mi sembra di aver risolto un problema in realtà se ne presenta un'altro..

Riguarda sempre la textbox che tramuta in valuta..

TextBox8 = Format(TextBox8, "#,###0.#0 €")

Foglio3.Cells(numriga, 3) = TextBox8.Text

In questo modo effettivamente mi riporta i valori anche con la virgola, ad esempio se scrivo 25,81..

Ora però quando lo inserisco non viene tramutato in valuta € nella cella..

Il problema l'avevo risolto seguendo il tuo consiglio, ovvero mettendo questo codice:

Foglio3.Cells(numriga, 3) = Val(TextBox8.Text) * 1

Ma così facendo se scrivo ad esempio 25,81 mi metteva sempre 22,00€ 🙁

Aiutami tu ti prego perché ho provato in tutti i modi ma non riesco ad ottenere entrambe le cose, ovvero valuta € e numeri dopo la virgola..

 

Grazie in anticipo!

In tanto per sicurezza ti allego il file con le ultime modifiche.

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 253 pts]

E' l'ultima versione? non trovo riscontro ma forse sono troppo distratto io stamattina

[Dandelion1987Partecipante Dandelion1987]

Esatto 🙂

Comunque mi sono spiegato male io scusami.

Effettivamente il problema non è che non appaia la valuta, ma che nel terzo foglio chiamato "Totale" nella cella sotto (TOTALE) non funzioni la seguente formula (=SOMMA(Fatture!C2:C11)).

Il risultato è sempre 0,00€

Riguardo al discorso di prima invece io ho creato tre pulsanti btnInserisci1, btnInserisci2 e btnInserisci3 (uno per pagina della UserForm) e verificando i nomi sono stati correttamente inseriti.

Quando clicco btnInserisci3 l'inserimento dei dati viene aggiornato subito quando lo premo, mentre per btnInsersci2 ad esempio mi aggiorna subito cboTipo, mentre txtNfattura e TextBox8 vengono aggiornati in seguito al conferma della msgBox. Stesso vale per btnInserisci1. In vorrei che tutto si aggiornasse subito non appena clicco sul commandbutton come su btnInserisci3.

 

[Dandelion1987Partecipante Dandelion1987]

Aggiornamento

Riguardo il problema TxtBox con valuta per risolvere ho modificato il codice in questo modo:

Al posto di..

Foglio3.Cells(numriga, 3) = Val(TextBox8.Text) * 1

ho messo..

Foglio3.Cells(numriga, 3) = TextBox8.Text * 1

Ora non solo mi inserisce il numero con virgola, ma lo tramuta in valuta e il valore viene anche recepito dalla formula di somma citata prima.

Unico problema che ho riscontrato è che se lascio la TextBox8 vuota e premo il CommandButton btnInserisci2 mi viene fuori questo errore:

Segnaladomi l'errore proprio la riga di codice che ho modificato.

Non c'è un modo per evitare che crei questo errore?

RISOLTO:

On Error Resume Next
Foglio3.Cells(numriga, 3) = TextBox8.Text * 1
If Err.Number <> 0 Then
On Error GoTo 0
End If
TextBox8 = Format(TextBox8, "#,###0.#0 €")

Ora mi mancherebbe la parte relativa all'inserimento dei dati tramite btnInserisci1, 2 e 3.. 😀

Come hai visto dal file ho una Userform composta da 3 page.

Ognuna ha un CommandButton differente, e nel VBA ognuna esegue l'inserimento delle rispettive TextBox/ComboBox.

Il CommandButtun btnInserisci3 in tale senso funziona come voglio, nel senso che inseriti i dati me li trasferisce sul foglio in modo immediato prima che appaia la MsgBox.

Con gli altri CommandButton invece l'inserimento avviene dopo aver premuto OK nella MsgBox.

Come posso sistemare il codice in modo che funzioni? 🙂

Grazie!
 

[vecchio fracSenior Moderator vecchio frac Karma: 253 pts]

Invece che con On Error io controllerei che la textbox8 non sia vuota e nel caso inserirei il valore zero (if textbox8 = "" then textbox8 = 0)

Se rientro presto guardo meglio la tua ultima osservazione

[Dandelion1987Partecipante Dandelion1987]

Grazie mille!

Intanto posto il codice corretto come mi hai detto di fare senza error..

If Len(TextBox8.Text) <> 0 Then
Foglio3.Cells(numriga, 3) = TextBox8.Text * 1
Else
Foglio3.Cells(numriga, 3) = ""
End If

[vecchio fracSenior Moderator vecchio frac Karma: 253 pts]

Dandelion1987 ha scritto:

vorrei che tutto si aggiornasse subito non appena clicco sul commandbutton come su btnInserisci3.

Non mi è del tutto chiaro questo comportamento. Seguendo passo passo col debug non ci sono problemi, la cella viene ricalcolata e si aggiorna subito prima del Msgbox. Escamotage: aspetta un secondo prima di mostrare il messaggio e quindi prosegui.

Pertanto subito prima dei Msgbox a chiusura delle sub Inserisci1 e Inserisci2 metti questo codice di attesa:

   ... resto del codice
   Application.Wait Now + TimeValue("0:00:01")
   MsgBox "Inserimento avvenuto con successo."
End Sub

[Dandelion1987Partecipante Dandelion1987]

Grazie mille!

Ho risolto con il tuo suggerimento.

Mi scuso di non aver risposto prima, voglio ringraziarti per tutto l'aiuto che mi hai dato per la creazione del file.

Sei stato davvero disponibile e gentilissimo.

 

Grazie ancora!

[Autore]

Articoli