|
|
|
|
Strumenti |
31-07-2009, 10:19 | #1 |
Senior Member
Iscritto dal: Mar 2003
Messaggi: 1951
|
[VBA][EXCEL] codice variabile per scrivere celle e formati particolari
spero che la sezione sia quella giusta!
ho realizzato uno scadenziario per gestire le pratiche d'ufficio, ora inserisco il numero della pratica a mano ma vorrei che fosse automatico. Codice:
09 num data oggetto rif data fine ecc 001/09 29/07/09 pippo pluto 30/07/09 ecc al click sulla cella vuota (sotto quella già scritta) il codice legge la cella immediatamente sopra e scrive il testo aumentato di 1 (formato XXX/AA, X=cifre A=anno) la prima cella in alto è =OGGI() con formato AA, se servisse... posso creare del codice anche per vincolare la colonna "rif" ad una lista di nomi (anche scritti nel codice stesso, tanto sono pochi) e avere una listbox? grazie dell'aiuto che vorrete darmi! edit: intanto mi sto informando... Codice:
[B1] = [B1] + 1 [E1] = Format([B1], "000") & "/" & Mid(Year(Now()), 3, 2) Ultima modifica di radeon_snorky : 31-07-2009 alle 10:29. |
31-07-2009, 12:44 | #2 |
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Io vedrei bene un sistema di inserimento tramite UserForm, magari con foglio protetto.
In questo modo potresti intercettare ogni errore di battitura e inoltre non avresti più il problema di dover inserire la prima riga a mano... |
31-07-2009, 17:21 | #3 | |
Senior Member
Iscritto dal: Mar 2003
Messaggi: 1951
|
Quote:
potrei però riciclare un poco di quel progetto e riadattarlo ad un foglio excel, così sarebbe più digeribile... |
|
31-07-2009, 17:51 | #4 | |
Member
Iscritto dal: Aug 2008
Messaggi: 178
|
Quote:
Codice:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myCel As Range Dim Prec Set myCel = Range("A1").End(xlDown).Offset(1) If Not Intersect(Target, myCel) Is Nothing Then Prec = Range("A1").End(xlDown).Value myCel.Value = Format(CLng(Left(Prec, 3)) + 1, "000") & Right(Prec, 3) End If End Sub In alternativa, molto meglio secondo me, scrivi il primo numero di registro in A3 (secondo il tuo esempio) e in A4 scrivi: Codice:
=SE(O(A3="";B4="");"";TESTO(SINISTRA(A3;3)+1;"000")&"/"&TESTO(OGGI();"aa")) In questo caso calcola direttamente l'anno, ma si può fare come nel codice riportato sopra. Per quanto riguarda il secondo quesito puoi usare la "Convalida dei dati". dalla barra dei menù seleziona: Dati>Convalida>Consenti:Elenco nel campo Origine scrivi direttamente le voci separate da ";" se sono poche oppure il riferimento all'intervallo di celle contenenti l'elenco (nel caso si trovi su un altro foglio di lavoro dai un nome all'intervallo e usa il nome). Ciao |
|
31-07-2009, 19:35 | #5 | |
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Quote:
|
|
05-08-2009, 17:01 | #6 | |
Senior Member
Iscritto dal: Mar 2003
Messaggi: 1951
|
Quote:
mi piace! |
|
05-08-2009, 19:51 | #7 | |
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Quote:
http://www.hwupgrade.it/forum/showthread.php?t=2026676 [ vedi mio post #8 ] |
|
06-08-2009, 14:57 | #8 | |
Senior Member
Iscritto dal: Mar 2003
Messaggi: 1951
|
Quote:
|
|
07-08-2009, 11:02 | #9 |
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Risorse online specifiche su UserForm VBA non ne ho da segnalare. Cmq, al post che ti ho linkato mi pare di aver spiegato tutto abbastanza chiaramente...
|
07-08-2009, 22:55 | #10 |
Senior Member
Iscritto dal: Mar 2003
Messaggi: 1951
|
ho bisogno di info su questi codici:
Codice:
Private Sub SaveBtn_Click() ActiveWorkbook.Sheets("scadenze").Activate Range("B1").Select Do If IsEmpty(ActiveCell) = False Then ActiveCell.Offset(1, 0).Select End If Loop Until IsEmpty(ActiveCell) = True ActiveCell.Value = Format(data1.Value, "gg/mm/aaaa") ActiveCell.Offset(0, 1) = data2.Value ActiveCell.Offset(0, 2) = data3.Value ActiveCell.Offset(0, 3) = data4.Value ActiveCell.Offset(0, 4) = data5.Value Range("B1").Select End Sub Codice:
Public r As Integer Private Sub UserForm_Initialize() trova_riga_vuota '<-- richiama la sub per cercare la prima riga vuota End Sub Sub trova_riga_vuota() r = 0 Do r = r + 1 Loop Until scadenze.Cells(r, 2) = "" And _ scadenze.Cells(r, 3) = "" And _ scadenze.Cells(r, 4) = "" And _ scadenze.Cells(r, 5) = "" And _ scadenze.Cells(r, 6) = "" Or r = 5000 End Sub Private Sub SaveBtn_Click() scadenze.Cells(r, 2) = data1 scadenze.Cells(r, 3) = data2 scadenze.Cells(r, 4) = data3 scadenze.Cells(r, 5) = data4 scadenze.Cells(r, 6) = data5 End Sub ho preferito non andare a scrivere sulla colonna A visto che il codice di ses4 mi sembrava molto valido! sulla form vorrei poter visualizzare il numero della pratica con una label che, alla pressione di SaveBtn, vada a leggere proprio il dato generato dalla formula... ho semplicemente aggiunto alla fine della sub SaveBtn_Click() il comando PratLabel.Caption = ActiveCell.Offset(0, -1).Text però non so come dare il riferimento all'ultima riga... e poi, ActiveCell.Value = Format(data1.Value, "gg/mm/aaaa") non fa quello che dovrebbe!!! mi scrive "gg/mese in cifre/aaaa" G e A non li converte in cifre! come mai!?!?!?! EDIT: mi sono accorto che accetta dd/mm/yyyy eppure il mio excel è italiano... (e win7 è settato su italiano) comunque mi serve sapere come "obbligare" l'inserimento e la visualizzazione di giorno/mese/anno in quest'ordine, visto che al salvataggio lo inverte all'americana... EDIT2: avevo scordato di togliere la formattazione su "data" di quella colonna e andava in tilt.. ora fa come mi aspettavo (anche se fubziona solo con dd/mm/yyyy e non con gg/mm/aaaa... poco male!) Ultima modifica di radeon_snorky : 08-08-2009 alle 00:31. |
08-08-2009, 14:02 | #11 | |
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Quote:
Che senso hanno tutti quegli Offset e tutti quegli And + Select su ogni singola cella, quando, come già detto, si può testare il record vuoto semplicemente dalla .Text del Range che lo rappresenta ? Mettiamo che il Foglio con la tabella sia così strutturato : [A1] : 09 [A2:E2] : num, data, oggetto, rif, data fine Il Range-Record è un [Ax:Ex], a partire dall'indice 3 in poi : Codice:
indiceNuovaRiga = 3 Do If Range("A" & indiceNuovaRiga & ":E" & indiceNuovaRiga).Text = "" Then Exit Do Else indiceNuovaRiga = indiceNuovaRiga + 1 End If Loop MsgBox indiceNuovaRiga Una volta che indiceNuovaRiga è calcolato e noto : Codice:
'codice nuova pratica Dim anno As String anno = Range("A1").Text Dim numPratica As String numPratica = Format(indiceNuovaRiga - 2, "000") Dim codiceNuovaPratica As String codiceNuovaPratica = numPratica & "/" & anno |
|
13-08-2009, 08:44 | #12 |
Senior Member
Iscritto dal: Mar 2003
Messaggi: 1951
|
in effetti è più comodo... solo che avendomi linkato l'altra discussione pensavo che quel codice facesse al caso mio...
ho acquistato un libro "pocket" che parla di vba per excel... ma è spiegato male! o sarò io di coccio?!!?!? comunque grazie! tra poco si parte per le ferie, metto il "progetto" in stallo! ciao!!! |
13-08-2009, 14:06 | #13 | ||
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Quote:
Quote:
Non sei tu di coccio, sono quei manuali lì che vanno evitati. |
||
26-08-2009, 00:10 | #14 | |
Senior Member
Iscritto dal: Mar 2003
Messaggi: 1951
|
Quote:
ho ripreso la gestazione, fila che è un piacere... saranno state le ferie!??!?! EDIT: ho modificato "MsgBox indiceNuovaRiga" per adattarlo meglio al contesto, altrimenti era un messaggio con poco senso pratico curiosità: come posso evitare l'avviso di protezione all'avvio del file? naturalmente senza compromettere la sicurezza, considerando che in ufficio girano file provenienti da ogni dove non vorrei disattivare completamente il controllo... ora non mi resta che vedere cosa ne pensano in ufficio e pensare alle ultime 2 "cosucce"... avvisi scadenze e stampa... quindi sono ancora lontano dalla conclusione, eh? Ultima modifica di radeon_snorky : 26-08-2009 alle 12:39. |
|
27-08-2009, 09:34 | #15 |
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Ha poco senso. Quella è un'impostazione di Excel, non della tua applicazione. Prendi il file, spostalo su un altro Pc che ha altre impostazioni sulla protezione macro e deciderà lui se ammetterle o bloccarle... In ogni caso io imposto sempre su "Medio", ossia lascio che l'utente decida di bloccare o meno il codice VBA. Ovviamente quando distribuisco ad altri utenti faccio un minimo di documentazione in cui spiego che se vogliono usare il mio programma devono consentire l'esecuzione...
|
27-08-2009, 10:52 | #16 | |
Senior Member
Iscritto dal: Mar 2003
Messaggi: 1951
|
Quote:
ieri sera ho fatto vedere il "programma" in ufficio, mi hanno chiesto delle modifiche e delle "semplificazioni" appena ho un secondo ti posto il codice e un paio di screen, così, SE TI SCONFINFERA L'IDEA di aiutarmi (più di quanto tu non stia già facendo....) diciamo per consigliarmi su come procedere all'ottimizzazione del tutto grazie! |
|
31-08-2009, 08:26 | #17 |
Senior Member
Iscritto dal: Mar 2003
Messaggi: 1951
|
lo screen:
http://www.hwupgrade.it/forum/attach...1&d=1251703051 dovrei ottimizzare tutto questo e procedere con ricerca e stampa... codice inserimento pratica: Codice:
Private indiceNuovaRiga As Long Private Sub UserForm_Initialize() Dim sh As Worksheet Dim lng1 As Long Dim lUltRiga1 As Long Set sh = Worksheets("tecnico") With sh lUltRiga1 = .Range("A" & _ Rows.Count).End(xlUp).Row For lng1 = 2 To lUltRiga1 Me.ComboBox3.AddItem (.Cells(lng1, 1).Value) Next End With Set sh = Nothing Dim lng2 As Long Dim lUltRiga2 As Long Set sh = Worksheets("committente") With sh lUltRiga2 = .Range("A" & _ Rows.Count).End(xlUp).Row For lng2 = 2 To lUltRiga2 Me.ComboBox1.AddItem (.Cells(lng2, 1).Value) Next End With Set sh = Nothing Dim lng3 As Long Dim lUltRiga3 As Long Set sh = Worksheets("proprietà") With sh lUltRiga3 = .Range("A" & _ Rows.Count).End(xlUp).Row For lng3 = 2 To lUltRiga3 Me.ComboBox4.AddItem (.Cells(lng3, 1).Value) Next End With Set sh = Nothing Dim anno As String anno = Range("A1").Text indiceNuovaRiga = 3 Do If Range("A" & indiceNuovaRiga & ":E" & indiceNuovaRiga).Text = "" Then Exit Do Else indiceNuovaRiga = indiceNuovaRiga + 1 End If Loop MsgBox "la pratica che stai per inserire è la n° " & indiceNuovaRiga - 3 & " del 20" & anno Dim numPratica As String numPratica = Format(indiceNuovaRiga - 3, "000") Dim codiceNuovaPratica As String codiceNuovaPratica = numPratica & "/" & anno numero.Caption = codiceNuovaPratica cmd_inserisci.Enabled = True End Sub Private Sub cmd_inserisci_Click() Dim anno As String anno = Range("A1").Text Dim numPratica As String numPratica = Format(indiceNuovaRiga - 3, "000") Dim codiceNuovaPratica As String codiceNuovaPratica = numPratica & "/" & anno If TextBox1.Value = "" Or ComboBox2.Text = "" Then MsgBox "devi compilare correttamente la pratica!" Exit Sub End If Sheets("pratiche").Range("A" & indiceNuovaRiga).FormulaR1C1 = codiceNuovaPratica Sheets("pratiche").Range("B" & indiceNuovaRiga).FormulaR1C1 = TextBox1.Text Sheets("pratiche").Range("C" & indiceNuovaRiga).FormulaR1C1 = ComboBox1.Text Sheets("pratiche").Range("D" & indiceNuovaRiga).FormulaR1C1 = ComboBox4.Text Sheets("pratiche").Range("E" & indiceNuovaRiga).FormulaR1C1 = TextBox3.Text Sheets("pratiche").Range("F" & indiceNuovaRiga).FormulaR1C1 = TextBox4.Text Sheets("pratiche").Range("G" & indiceNuovaRiga).FormulaR1C1 = TextBox5.Text Sheets("pratiche").Range("H" & indiceNuovaRiga).FormulaR1C1 = ComboBox2.Text Sheets("pratiche").Range("I" & indiceNuovaRiga).FormulaR1C1 = ComboBox3.Text Sheets("pratiche").Range("J" & indiceNuovaRiga).FormulaR1C1 = TextBox6.Text Sheets("pratiche").Range("K" & indiceNuovaRiga).FormulaR1C1 = TextBox7.Text Sheets("pratiche").Range("L" & indiceNuovaRiga).FormulaR1C1 = TextBox8.Text Sheets("pratiche").Range("M" & indiceNuovaRiga).FormulaR1C1 = TextBox9.Text Sheets("pratiche").Range("N" & indiceNuovaRiga).FormulaR1C1 = TextBox10.Text Sheets("pratiche").Range("O" & indiceNuovaRiga).FormulaR1C1 = TextBox11.Text Sheets("pratiche").Range("P" & indiceNuovaRiga).FormulaR1C1 = TextBox12.Text Sheets("pratiche").Range("Q" & indiceNuovaRiga).FormulaR1C1 = TextBox13.Text Sheets("pratiche").Range("R" & indiceNuovaRiga).FormulaR1C1 = TextBox14.Text If indiceNuovaRiga = 65536 Then MsgBox "Impossibile inserire. Limite max. raggiunto" cmd_inserisci.Enabled = False Else indiceNuovaRiga = indiceNuovaRiga + 1 End If numero.Caption = "---/--" cmd_inserisci.Enabled = False End Sub Private Sub dataoggi_Click() TextBox1.Value = Format(Now(), "dd mm yyyy") End Sub Private Sub ClearBtn_Click() Unload Me Load moduloprat moduloprat.Show End Sub Private Sub ExitBtn_Click() Unload Me End Sub Codice:
Private indiceRiga As Long Dim codprat As String Private Sub UserForm_Initialize() codprat = InputBox("Numero pratica da modificare:") If codprat <> "" Then MsgBox "selezionata pratica " & codprat Else MsgBox "errore, inserisci numero pratica correttamente" Unload editform Exit Sub End If indiceRiga = codprat + 3 codprat = Format(codprat, "000") numero.Caption = codprat & "/" & Range("A1").Text TextBox1.Text = Sheets("pratiche").Range("B" & indiceRiga).FormulaR1C1 ComboBox1.Text = Sheets("pratiche").Range("C" & indiceRiga).FormulaR1C1 ComboBox4.Text = Sheets("pratiche").Range("D" & indiceRiga).FormulaR1C1 TextBox3.Text = Sheets("pratiche").Range("E" & indiceRiga).FormulaR1C1 TextBox4.Text = Sheets("pratiche").Range("F" & indiceRiga).FormulaR1C1 TextBox5.Text = Sheets("pratiche").Range("G" & indiceRiga).FormulaR1C1 ComboBox2.Text = Sheets("pratiche").Range("H" & indiceRiga).FormulaR1C1 ComboBox3.Text = Sheets("pratiche").Range("I" & indiceRiga).FormulaR1C1 TextBox6.Text = Sheets("pratiche").Range("J" & indiceRiga).FormulaR1C1 TextBox7.Text = Sheets("pratiche").Range("K" & indiceRiga).FormulaR1C1 TextBox8.Text = Sheets("pratiche").Range("L" & indiceRiga).FormulaR1C1 TextBox9.Text = Sheets("pratiche").Range("M" & indiceRiga).FormulaR1C1 TextBox10.Text = Sheets("pratiche").Range("N" & indiceRiga).FormulaR1C1 TextBox11.Text = Sheets("pratiche").Range("O" & indiceRiga).FormulaR1C1 TextBox12.Text = Sheets("pratiche").Range("P" & indiceRiga).FormulaR1C1 TextBox13.Text = Sheets("pratiche").Range("Q" & indiceRiga).FormulaR1C1 TextBox14.Text = Sheets("pratiche").Range("R" & indiceRiga).FormulaR1C1 MsgBox "pratica importata correttamente" End Sub Private Sub cmd_inserisci_Click() Sheets("pratiche").Range("A" & indiceRiga).FormulaR1C1 = numero.Caption Sheets("pratiche").Range("B" & indiceRiga).FormulaR1C1 = TextBox1.Text Sheets("pratiche").Range("C" & indiceRiga).FormulaR1C1 = ComboBox1.Text Sheets("pratiche").Range("D" & indiceRiga).FormulaR1C1 = ComboBox4.Text Sheets("pratiche").Range("E" & indiceRiga).FormulaR1C1 = TextBox3.Text Sheets("pratiche").Range("F" & indiceRiga).FormulaR1C1 = TextBox4.Text Sheets("pratiche").Range("G" & indiceRiga).FormulaR1C1 = TextBox5.Text Sheets("pratiche").Range("H" & indiceRiga).FormulaR1C1 = ComboBox2.Text Sheets("pratiche").Range("I" & indiceRiga).FormulaR1C1 = ComboBox3.Text Sheets("pratiche").Range("J" & indiceRiga).FormulaR1C1 = TextBox6.Text Sheets("pratiche").Range("K" & indiceRiga).FormulaR1C1 = TextBox7.Text Sheets("pratiche").Range("L" & indiceRiga).FormulaR1C1 = TextBox8.Text Sheets("pratiche").Range("M" & indiceRiga).FormulaR1C1 = TextBox9.Text Sheets("pratiche").Range("N" & indiceRiga).FormulaR1C1 = TextBox10.Text Sheets("pratiche").Range("O" & indiceRiga).FormulaR1C1 = TextBox11.Text Sheets("pratiche").Range("P" & indiceRiga).FormulaR1C1 = TextBox12.Text Sheets("pratiche").Range("Q" & indiceRiga).FormulaR1C1 = TextBox13.Text Sheets("pratiche").Range("R" & indiceRiga).FormulaR1C1 = TextBox14.Text MsgBox "aggiornamento pratica completato" Unload Me End Sub Private Sub ExitBtn_Click() Unload Me End Sub Codice:
Private Sub UserForm_Initialize() Dim sh As Worksheet Dim lng1 As Long Dim lUltRiga1 As Long Set sh = Worksheets("tecnico") With sh lUltRiga1 = .Range("A" & _ Rows.Count).End(xlUp).Row For lng1 = 2 To lUltRiga1 Me.ComboBox3.AddItem (.Cells(lng1, 1).Value) Next End With Set sh = Nothing Dim lng2 As Long Dim lUltRiga2 As Long Set sh = Worksheets("committente") With sh lUltRiga2 = .Range("A" & _ Rows.Count).End(xlUp).Row For lng2 = 2 To lUltRiga2 Me.ComboBox1.AddItem (.Cells(lng2, 1).Value) Next End With Set sh = Nothing Dim lng3 As Long Dim lUltRiga3 As Long Set sh = Worksheets("proprietà") With sh lUltRiga3 = .Range("A" & _ Rows.Count).End(xlUp).Row For lng3 = 2 To lUltRiga3 Me.ComboBox4.AddItem (.Cells(lng3, 1).Value) Next End With Set sh = Nothing End Sub Private Sub dataoggi_Click() TextBox1.Value = Format(Now(), "dd mm yyyy") End Sub Private Sub ClearBtn_Click() Unload Me Load searchform searchform.Show End Sub Private Sub ExitBtn_Click() Unload Me End Sub consigli? EDIT scrivo qui per non dimenticarlo... mi hanno fatto notare che la numerazione della pratica così com'è... aumenta di numero continuamente senza azzerarsi al cambio anno! urge soluzione! mumble mumble! Ultima modifica di radeon_snorky : 31-08-2009 alle 11:53. |
Strumenti | |
|
|
Tutti gli orari sono GMT +1. Ora sono le: 02:50.