› Sviluppare funzionalita su Microsoft Office con VBA › Macro per sottrarre delle quantità da una maschera di inserimento ad un foglio.
-
AutoreArticoli
-
Buongiorno a tutti,
ho creato un piccolo programmino per contabilizzare le uscite di alcuni articoli creati su un foglio di Excel denominato: Controllo Giacenze, io vorrei che quando si attivano le macro sui pulsanti modulo consegna vestiario e modulo consegna magazzino e partono le maschere di inserimento dati quando seleziono l'articolo e le quantità queste si vadano a sottrarre dalla colonna "C" del foglio Controllo Giacenze ed il risultato (Giacenza iniziale - quantità sottratta dalla userform) si materializzi nella colonna "D" Giacenza Finale e che quando questo numero è uguale o minore del valore della colonna "E" (Alert) ad ogni apertura del file mi generi un allert fino a quando il valore non supera la soglia di alert.
In allegato codice e file.
userform ---------------------------------------------- Option Explicit Private Sub Articolo_Change() End Sub Private Sub CommandButton6_Click() ' CANCELLA I DATI DALLA MASCHERA NomeCognome = "" Articolo = "" Taglia = "" Quantità = "" Richiesta = "" Referente = "" End Sub Private Sub CommandButton7_Click() Call SalvaInviaPDF End Sub Private Sub UserForm_Initialize() ' INSERISCE LA DATA NELLA MASCHERA TextBox1 = Date End Sub Private Sub CommandButton3_Click() ' ESCE DALLA MASCHERA Unload Me End Sub Private Sub CommandButton5_Click() If NomeCognome.Text = "" Then ' ROUTINE CHE CONTROLLA SE I CAMPI SONO VUOTI E TI FA APPARIRE UN ALLERT MsgBox ("Campo Nome e Cognome Obbligatorio!") NomeCognome.SetFocus Exit Sub End If If Articolo.Text = "" Then MsgBox ("Campo Articolo Obbligatorio!") Articolo.SetFocus Exit Sub End If If Taglia.Text = "" Then MsgBox ("Campo Taglia Obbligatorio!") Taglia.SetFocus Exit Sub End If If Quantità.Text = "" Then MsgBox ("Campo Quantità Obbligatorio!") Quantità.SetFocus Exit Sub End If If Richiesta.Text = "" Then MsgBox ("Campo Richiesta Obbligatorio!") Richiesta.SetFocus Exit Sub End If If Referente.Text = "" Then ' ROUTINE CHE CONTROLLA SE I CAMPI SONO VUOTI E TI FA APPARIRE UN ALLERT MsgBox ("Campo Referente Obbligatorio!") Referente.SetFocus Exit Sub End If '------------------------------------------------------------------------------------------------- ActiveSheet.Unprotect ("pippo") ' sblocca il foglio Application.ErrorCheckingOptions.NumberAsText = False Dim iRow As Integer 'dichiara la variabile numerica Dim ShDest As Worksheet 'dichiara la variabile del foglio su dove bisogna scrivere Dim ShDest2 As Worksheet 'dichiara la variabile del foglio su dove bisogna scrivere Set ShDest2 = Worksheets("Consegne Vestiario") 'definisce in quale foglio scrivere i dati ShDest2.Range("A20") = NomeCognome ShDest2.Range("B61") = Referente ShDest2.Range("C16") = UnitaOperativa iRow = 23 'si comincia dalla riga 19 While ShDest2.Cells(iRow, 1).Value <> "" 'se la cella contiene dati, si passa alla successiva iRow = iRow + 1 'riga successiva Wend ShDest2.Cells(iRow, 1) = Articolo ShDest2.Cells(iRow, 4) = Taglia ShDest2.Cells(iRow, 5) = Quantità ShDest2.Cells(iRow, 6) = Richiesta Set ShDest2 = Nothing 'azzera la variabile Set ShDest = Worksheets("Registro Consegne") 'definisce in quale foglio scrivere i dati Sheets("Registro Consegne").Visible = True 'rende il foglio di lavoro visibile Worksheets("Registro Consegne").Select ' seleziona il foglio Registro Consegne ActiveSheet.Unprotect ("pippo") ' sblocca il foglio iRow = 2 'si comincia dalla riga 2 While ShDest.Cells(iRow, 1).Value <> "" 'se la cella contiene dati, si passa alla successiva iRow = iRow + 1 'riga successiva Wend ShDest.Cells(iRow, 1) = TextBox1 ShDest.Cells(iRow, 2) = NomeCognome ShDest.Cells(iRow, 3) = Articolo ShDest.Cells(iRow, 4) = Taglia ShDest.Cells(iRow, 5) = Quantità ShDest.Cells(iRow, 6) = Richiesta Set ShDest = Nothing 'azzera la variabile ActiveSheet.Protect ("pippo") Sheets("Registro Consegne").Visible = False Worksheets("Consegne Vestiario").Select fine: MsgBox ("Registrazione Effettuata!") Articolo = "" Taglia = "" Quantità = "" Referente = "" Worksheets("Consegne Vestiario").Select ActiveSheet.Protect ("pippo") End Sub '------------------------------------------------------------------------------------------------------------------------ salva & Stampa Sub SalvaStampaNV() Dim xSht As Worksheet Dim xFileDlg As FileDialog Dim xFolder As String Dim xYesorNo As Integer Dim xOutlookObj As Object Dim xEmailObj As Object Dim xUsedRng As Range Dim X As String Dim Y As String X = Range("A20").Value Y = Range("C20").Value Z = Replace(Range("G4").Value, "/", "-") On Error Resume Next 'fa lavorare la macro anche se in presenza di errori. Set xSht = ActiveSheet Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) xFolder = ("E:\Vestiario\02 Consegna DPI\") + "\" + X + "_" + Y + "_" + Z + ".pdf" If Len(Dir(xFolder)) > 0 Then xYesorNo = MsgBox(xFolder & " ESISTE già." & vbCrLf & vbCrLf & "Vuoi SOVRASCRIVERE il File??", _ vbYesNo + vbQuestion, "File già ESISTENTE!") On Error Resume Next If xYesorNo = vbYes Then Kill xFolder Else MsgBox "Premi OK per uscire senza SALVARE!", vbCritical, "File non SALVATO!" Exit Sub End If If Err.Number <> 0 Then MsgBox "Impossibile ELIMINARE il file ESISTENTE. Assicurati che il file non sia aperto o protetto da scrittura." _ & vbCrLf & vbCrLf & "Premere OK per USCIRE senza SALVARE!.", vbCritical, "Impossibile ELIMINARE il file!" Exit Sub End If End If Set xUsedRng = xSht.UsedRange If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then 'Save as PDF file xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard End If 'Save as PDF file Range("A1:G71").Select 'Range("F49").Activate ActiveSheet.PageSetup.PrintArea = "$A$1:$G$71" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False End SubAllegati:
You must be logged in to view attached files.Ma ti costava tanto inserire anche un semplice:
Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.DisplayFullScreen = False ' disattiva modalità a tutto schermo End SubMi ha fatto persino passare la voglia di analizzare il tuo progetto!!
Ma ti costava tanto inserire anche un semplice:
Spiegagli anche il perché, altrimenti rimane un'affermazione apodittica 😀
In apertura il foglio viene messo a schermo intero, e questa impostazione rimane memorizzata da Excel anche per le successive istanze di Excel. Perciò quando chiudi il file e apri un altro file di Excel, questo verrà a aperto a schermo intero e senza menu (rimedio premendo Esc, comunque, non è una tragedia).
Il consiglio di rollis è valido sempre, così all'apertura successiva di un altro file le impostazioni sono quelle normali. Questa operazione (di ripristino delle condizioni normali) è consigliato farla ogni volta che si modifica qualcosa che riguarda l'aspetto di Excel ma anche qualcosa delle sue impostazioni interne (per esempio, la modalità di ricalcolo automatica o manuale).
Spiegagli anche il perché, altrimenti rimane un'affermazione apodittica
Avevo appositamente aggiornato il commento alla riga
.Io non ho capito la risposta di rollis, perché dovrebbe risolvere il quesito di mflauto ?
Grazie come sempre Vecchio Frac,
secondo te è fattibile la mia domanda?
perché dovrebbe risolvere il quesito di mflauto ?
No, non lo risolve, è solo una precisazione (oggi si va di eufemismi
)secondo te è fattibile la mia domanda?
Sarò onesto con te, ho avuto altro da fare stamattina, se nel pomeriggio riesco a non addormentarmi su queste statistiche che mi ha rifilato il Capo, ci do un occhio volentieri.
Tutta la sezione di codice è un po' incasinata ma grosso modo si riesce a capire (consiglio di indentare il codice per migliorare la leggibilità, poi potremmo anche parlare di ottimizzare ma non è questo il momento).
Parliamo ad esempio del form MascheraNV.
Inserisco i dati richiesti (soprattutto ci interessano l'articolo e la quantità, il primo va ricercato nel foglio Controllo giacenze e il secondo va sottratto alla giacenza attuale o iniziale).
Il codice del pulsante Registra vestiario (il pulsante si chiama CommandButton5, non è vietato cambiargli nome 🙂 ) memorizza i dati aggiungendoli al foglio Consegne vestiario, è quindi qui che vuoi fare il controllo e aggiornare la giacenza del foglio Controllo giacenze?Devi scrivere il codice che:
- cerca in controllo giacenze l'articolo scaricato
- nella riga corrispondente preleva la giacenza attuale ("iniziale")
- sottrae la quantità richiesta
- aggiorna la giacenza attuale.Nell'evento Open del Workbook farai il controllo dei valori interessati in modo da far comparire l'alert al verificarsi della condizione richiesta e che hai descritto poco sopra.
Te la senti di stendere il codice necessario? Nota: per cercare un valore in un elenco usa il metodo Find applicato alla colonna in cui cercare il dato: Range("A:A").Find(valore). Quando il valore è trovato, ti restituisce un oggetto Range che punta alla colonna A, da qui ti sposti con Range(...).Offset(,xx) per xx colonne a destra fino a recuperare i valori delle colonne che interessano, alla riga trovata.
Se hai capito la metà dopo questa non-spiegazione, è già incoraggiante
Ti ringrazio, provo a buttare giù un po' di codice, una domanda ma la routine la inserisco nel command button5 e il valore numerico che trovo con l'istruzione range offset va racchiuso in una variabile e poi come gli dico di sottrarre il valore dalla giacenza iniziale?
ma la routine la inserisco nel command button5
Io credo che sia il posto più logico perchè è il pulsante che convalida l'inserimento dei dati nell'userform e provvede a riempire il foglio Consegne vestiario. Nel momento in cui immetti i nuovi dati perchè li hai prelevati dal foglio che li contiene, aggiorni il magazzino con la nuova giacenza ricalcolata. Devi fare l'operazione per ogni articolo che scegli nell'userform quindi quella è la routine più adatta.
il valore numerico che trovo con l'istruzione range
Si può fare anche senza Offset visto che conosci le colonne dove si trovano i dati e queste colonne sono fisse.
ConSet f = Range("A:A").Find(valore)trovi la riga in foglio giacenze corrispondente al valore cercato. In quella riga, a una determinata cella della colonna C, si trova la giacenza:Cells(f.row, "E"). Prelevi questo valore, gli sottrai la quantità che hai definito nel form alla combobox "Quantità" e immetti il nuovo valore nella cellaCells(f.Row, "D").Vecchio Frac, grazie di tutto, l'unica cosa che non ho capito è come prendere i valori dal registro delle consegne quando la routine scrive su shdest.cells(irow3) e (irow5) e portali nel foglio controllo giacenze? Scusami ma io sono davvero ad un livello base.
Devi qualificare il range di destinazione, cioè devi fare riferimento al foglio desiderato quando coinvolgi un Range di celle.
Nel tuo codice ShDest rappresenta il foglio "Registro Consegne" (è dichiarato così nel codice del commandbutton5). Quando vedo la riga While ShDest.Cells(iRow, 1).Value <> "" io capisco che si verifica il valore della cella del foglio Registro consegne che si trova in riga iRow della colonna A.
Similmente quindi puoi fare riferimento a una cella qualsiasi del foglio Controllo giacenze qualificando il range desiderato: per esempio qualcosa come
Worksheets("Controllo giacenze").Range("C2").Quindi prima cerchi l'articolo prescelto, e adesso sai che devi fare
Set f = Worksheets("Controllo giacenze").Range("A:A").Find(articolo); adesso conWorksheets("Controllo giacenze").Cells(f.Row, "C")hai la giacenza attuale a cui devi sottrarre la quantità definita nel combobox Quantità.Ti ho detto tutto quello che ti serve 🙂
Buonasera Vecchio Frac,
invece di una routine ho utilizzato la formula somma più se ed ho ottenuto lo stesso risultato, l 'unica cosa che questa formula non mi riconosce il numero nella cellula del registro consegne, ho provato di tutto, esiste una istruzione che converte tutta la colonna in formato numero o secondo te è un problema di refresh?
esiste una istruzione che converte tutta la colonna in formato numero
L'istruzione esiste ed è qualcosa come:
Range("A:A").NumberFormat = "0.00"che imposta il formato numerico alla colonna A.
questa formula non mi riconosce il numero nella cellula del registro consegne
Ma il numero è inserito come testo? o è frutto di una formula? non è un problema di refresh ma di come Excel sta memorizzando il dato.
Buon pomeriggio Vecchio Frac,
se non premo il tasto enter nella colonna E:E del Registro Consegne; la formula non viene aggiornata nella colonna D:D del folder Controllo Giacenze, ti inserisco il codice!
ActiveSheet.Unprotect ("pippo") ' sblocca il foglio Application.ErrorCheckingOptions.NumberAsText = False Dim iRow As Integer 'dichiara la variabile numerica Dim ShDest As Worksheet 'dichiara la variabile del foglio su dove bisogna scrivere Dim ShDest2 As Worksheet 'dichiara la variabile del foglio su dove bisogna scrivere Set ShDest2 = Worksheets("Consegne Vestiario") 'definisce in quale foglio scrivere i dati ShDest2.Range("A20") = NomeCognome ShDest2.Range("B61") = Referente ShDest2.Range("C16") = UnitaOperativa iRow = 23 'si comincia dalla riga 19 While ShDest2.Cells(iRow, 1).Value <> "" 'se la cella contiene dati, si passa alla successiva iRow = iRow + 1 'riga successiva Wend ShDest2.Cells(iRow, 1) = Articolo ShDest2.Cells(iRow, 4) = Taglia ShDest2.Cells(iRow, 5) = Quantità ShDest2.Cells(iRow, 6) = Richiesta Range("E:E").NumberFormat = "0.00" Set ShDest2 = Nothing 'azzera la variabile Set ShDest = Worksheets("RCM") 'definisce in quale foglio scrivere i dati Sheets("RCM").Visible = True 'rende il foglio di lavoro visibile Worksheets("RCM").Select ' seleziona il foglio Registro Consegne ActiveSheet.Unprotect ("pippo") ' sblocca il foglio iRow = 2 'si comincia dalla riga 2 While ShDest.Cells(iRow, 1).Value <> "" 'se la cella contiene dati, si passa alla successiva iRow = iRow + 1 'riga successiva Wend ShDest.Cells(iRow, 1) = TextBox1 ShDest.Cells(iRow, 2) = NomeCognome ShDest.Cells(iRow, 3) = Articolo ShDest.Cells(iRow, 4) = Taglia ShDest.Cells(iRow, 5) = Quantità ShDest.Cells(iRow, 6) = Richiesta Range("E:E").NumberFormat = "0.00" If TypeName(Selection) = "Range" Then Selection.Calculate Set ShDest = Nothing 'azzera la variabile 'ActiveSheet.Protect ("pippo") Sheets("RCM").Visible = False Worksheets("Consegne Vestiario").Select fine: MsgBox ("Registrazione Effettuata!") Articolo = "" Taglia = "" Quantità = "" Referente = "" Worksheets("Consegne Vestiario").Select 'ActiveSheet.Protect ("pippo") End Subla formula non viene aggiornata nella colonna D:D
Mi vien da pensare che Excel non è impostato sul ricalcolo automatico ma su quello manuale.

If TypeName(Selection) = "Range" Then Selection.Calculate

Application.CalculateFullBuonasera Vecchio Frac;
nulla da fare l'Excel è impostato con il calcolo automatico e anche con l'istruzione:
If TypeName(Selection) = "Range" Then Selection.Application.CalculateFull
Range("E:E").NumberFormat = "0.00"mi da lo stesso errore o meglio se non premo enter non fa la sottrazione!
Ma scusa perchè vincoli il ricalcolo alla verifica se una cella è di tipo Range? Se non selezioni altri tipi di oggetto puoi stare sicuro quella If non ti serve. Fai Application.CalculateFull semplicemente senza If.
A parte questo trovo strano che il ricalcolo non si attui. A meno che non ci sia uno ScreenUpdating = False da qualche parte (che non vedo) o nu blocco del foglio (che non vedo e se fosse così ti direbbe che non può modificare la cella).
Per sicurezza mettici un Application.ScreenUpdating = True alla fine della Sub e vediamo.
Altrimenti... posta il file 🙂
Buonasera,
ho messo il Application.ScreenUpdating = True alla fine della Sub, avevo già messo l'unprotec,
ti allego il file grazie.
Allegati:
You must be logged in to view attached files.Buonasera Vecchio Frac,
Ma poi sei riuscito a capire qual è il problema, ho rifatto la macro in un nuovo modulo senza protezione del foglio e senza l'Application.ScreenUpdating ma non ho riscontrato lo stesso problema?
In realtà non c'è alcun problema.
Sul file che hai allegato nel post precedente, funziona tutto senza problemi. In registro consegne cambio un valore di quantità (colonna E), e l'aggiornamento è regolarmente effettuato nel foglio controllo giacenze, colonna D.
A questo punto sono io che non ho capito il problema 🙂
Buonasera Vecchio Frac,
ma sei sicuro di aver fatto eseguire la routine?
ti allego nuovamente il file!
Allegati:
You must be logged in to view attached files.Credo di aver inserito i dati correttamente. La routine mi pare che funzioni. Mi secca non capire cosa mi sfugge 🙂
-
AutoreArticoli
