Formato data da textbox

Versione Completa   Stampa   Cerca   Utenti   Iscriviti     Condividi : FacebookTwitter
BG66
00sabato 8 aprile 2017 14:58
Ciao a tutti,
il seguente script fà egregiamente il suo lavoro ma ho scoperto che anche formattando la colonna nel formato gg/mm/aaaa questo non viene rispettato (esempio il giorno 01/04/2017 mi è diventato 04/01/2017).
Cosa devo correggere? E come sistemo le date già presenti?
https://www.dropbox.com/s/dxw1b1nxosq7406/copiare_nomi_forum_v1%2B.xls?dl=0

 Sub Inserisci_Dati() 
Dim ws1 As Worksheet 
Set ws1 = ThisWorkbook.Sheets("Anno") 
Dim iRow As Long ws1.Select iRow = 2 'riga da cui partire per scrivere i dati 
If ws1.Cells(iRow, 1).Value = "" Then    
Else       
iRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1 
End If 
ws1.Cells(iRow, 1) = UserForm1.TextBox1.Value 
ws1.Cells(iRow, 4) = UserForm1.TextBox2.Value 
ws1.Cells(iRow, 5) = UserForm1.TextBox3.Value  
If UserForm1.OptionButton1.Value = True Then Sheets("Anno").Cells(iRow, 3).Value = "1°turno" 
If UserForm1.OptionButton2.Value = True Then Sheets("Anno").Cells(iRow, 3).Value = "2°turno" 
If UserForm1.OptionButton3.Value = True Then Sheets("Anno").Cells(iRow, 3).Value = "3°turno" 
If UserForm1.OptionButton4.Value = True Then Sheets("Anno").Cells(iRow, 2).Value = "R1" 
If UserForm1.OptionButton5.Value = True Then Sheets("Anno").Cells(iRow, 2).Value = "R2" 
If UserForm1.OptionButton6.Value = True Then Sheets("Anno").Cells(iRow, 2).Value = "R3" 
     
For x = 1 To 3 'Ciclo di cancellazione dati 
    UserForm1.Controls("TextBox" & x) = ""     
Next x         
For y = 1 To 6 'Ciclo di cancellazione dati 
        UserForm1.Controls("OptionButton" & y) = ""         
Next y         
With ws1     
uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A         
For y = 5 To uRow  'ciclo che spazzola dalla riga 5 all'ultima piena
If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene                 
With .Range("A1:E" & y).Borders  'stabilisce l'intervallo che va dalla cella A1 alla Cella E (numero di riga ultima cella piena)                     .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo                     .ColorIndex = 12  'questa riga stabilisce il colore del bordo                     .Weight = 1  'questa riga stabilisce lo spessore del bordo (1 è il più piccolo)                 
End With             
End If                          
Next   
End With MsgBox "Caricamento dati effettuato" 
UserForm1.Hide    
Application.DisplayAlerts = False    
ActiveWorkbook.Save    
ActiveWorkbook.Close    
Application.DisplayAlerts = True  
Set ws1 = Nothing  
End Sub




Grazie in anticipo.

PS Come d'abitudine nell'incollare il codice ho perso l'indentatura!!
PS2 Per un'altra operazione,questo file diventa sorgente quindi viene aperto per pochi secondi. Dovrei quindi includere un comando nella macro presente sul file destinatario per evitare che si apra la userform in automatico. E' fattibile?
alfrimpa
00sabato 8 aprile 2017 15:08
Ciao Gene

Prova così


ws1.Cells(iRow, 1) = Format(Userform.TextBox1.Value, "mm/dd/yyyy")
BG66
00sabato 8 aprile 2017 15:25
Ciao Alfredo,
è perfetta ma mentre rispondevi,stavo aggiungendo ulteriori info/aiuti. Hai dritte anche per gli altri due quesiti?
Precisamente:
E come sistemo le date già presenti?

PS2 Per un'altra operazione,questo file diventa sorgente quindi viene aperto per pochi secondi. Dovrei quindi includere un comando nella macro presente sul file destinatario per evitare che si apra la userform in automatico. E' fattibile?

Grazie

alfrimpa
00sabato 8 aprile 2017 15:47
Per le date precedenti credo tu debba sistemartele a mano direttamente sul foglio.

Al momento non ho modo di aprire il tuo file

Non ho capito il secondo quesito.
dodo47
00sabato 8 aprile 2017 17:25
Ciao
personalmente userei: ws1.Cells(iRow, 1) = CDate(UserForm1.TextBox1)

Per quanto riguarda l'altro quesito, la via più breve sarebbe quella di togliere dall'evento open l'apertura della uForm.

Se proprio non puoi (ma non vedo il motivo) la cosa si fa un più articolata. Prova nel file che apre "copiare_nomi...":
Sub test()
Dim wb As Workbook
Application.EnableEvents = False
Set wb = Workbooks.Open("C:\Users\stardust\Desktop\copiare_nomi_forum_v1+.xls")
Application.EnableEvents = True
wb.Application.EnableEvents = False

**tuo codice per file temporaneamente aperto**

wb.Application.EnableEvents = True
wb.Close
End Sub



saluti
Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa clicca qui
Tutti gli orari sono GMT+01:00. Adesso sono le 08:10.
Copyright © 2000-2024 FFZ srl - www.freeforumzone.com