PDA

View Full Version : [SOLVED] initialize all DTPicker same CustomFormat in UserForm



elsg
09-16-2014, 04:57 AM
I have 4 DTPicker, i need initialize all DTPicker equal code below.

Private Sub UserForm_Initialize() With DTPicker1
.Format = dtpCustom
.CustomFormat = "HH:mm:ss"
.UpDown = True
'.Value = CDate("00:00:00 AM")
End With
End Sub

Thank you!!

ranman256
09-16-2014, 05:41 AM
Private Sub UserForm_Initialize()
InitPicker DTPicker1
InitPicker DTPicker2
InitPicker DTPicker3
InitPicker DTPicker4
End Sub

Private Sub InitPicker( pvDTPicker )
With pvDTPicker
.Format = dtpCustom
.CustomFormat = "HH:mm:ss"
.UpDown = True
'.Value = CDate("00:00:00 AM")
End With
End Sub

elsg
09-16-2014, 05:45 AM
nice, very good!!

i need make more one question?..please!!!

how save data in each pvDTPicker in cell (last cell in column) [Col A -> DTPicker1, Col B -> DTPicker2, Col C -> DTPicker3, Col D -> DTPicker4]??

Kenneth Hobs
09-16-2014, 12:34 PM
Private Sub UserForm_Initialize() Dim i As Integer
For i = 1 To 4
InitPicker Controls("DTPicker" & i), TimeSerial(i, 0, 0)
Next i
End Sub

Private Sub InitPicker(pvDTPicker As DTPicker, dT As Date)
With pvDTPicker
.Format = dtpCustom
.CustomFormat = "HH:mm:ss"
.UpDown = True
.Value = dT
End With
End Sub


Private Sub CommandButton1_Click()
Dim i As Integer, c As Range

For i = 1 To 4
Set c = Cells(Rows.Count, i).End(xlUp).Offset(1)
c.Value = Controls("DTPicker" & i).Value
Next i

Unload Me
End Sub


Private Sub CommandButton2_Click()
Unload Me
End Sub

elsg
09-16-2014, 01:35 PM
I appreciate your help ...........
....but whan choice 23:00:00 and insert in cell. show this format. (11:00:00 PM).

I need show this format (23:00:00).

if change 11:00 then save in cell 11:00, but if change to 21:00 then insert in cell 21:00

Kenneth Hobs
09-16-2014, 01:53 PM
I guess it reads that way because you did not pre-format the cells manually as you wanted and then expected. To do it by code, use numberformat. e.g.

Private Sub UserForm_Initialize() Dim i As Integer
For i = 1 To 4
InitPicker Controls("DTPicker" & i), TimeSerial(i, 0, 0)
Next i
End Sub

Private Sub InitPicker(pvDTPicker As DTPicker, dT As Date)
With pvDTPicker
.Format = dtpCustom
.CustomFormat = "HH:mm:ss"
.UpDown = True
.Value = dT
End With
End Sub


Private Sub CommandButton1_Click()
Dim i As Integer, c As Range

For i = 1 To 4
Set c = Cells(Rows.Count, i).End(xlUp).Offset(1)
c.NumberFormat = "HH:mm:ss"
c.Value = Controls("DTPicker" & i).Value
Next i

Unload Me
End Sub


Private Sub CommandButton2_Click()
Unload Me
End Sub

elsg
09-17-2014, 07:45 AM
Good Kenneth Hobs (http://www.vbaexpress.com/forum/member.php?3661-Kenneth-Hobs) , thank you very much!

elsg
09-17-2014, 07:51 AM
hellow Kenneth, how save in differents columns?

Private Sub CommandButton1_Click()
Dim i As Integer, c As Range
Dim WS As Worksheet
Dim aRow As Long
With Me
aRow = Cells(Rows.Count, i).End(xlUp).Offset(1)
WS.Cells(aRow, 15) = .DTPicker1
WS.Cells(aRow, 16) = .DTPicker2
WS.Cells(aRow, 18) = .DTPicker3
WS.Cells(aRow, 19) = .DTPicker4
End With
'Unload Me
End Sub

Kenneth Hobs
09-17-2014, 10:20 AM
Private Sub CommandButton1_Click()
Dim i As Integer, ar(1 To 4) As Range

Set ar(1) = Range("O" & Rows.Count).End(xlUp).Offset(1)
Set ar(2) = Range("P" & Rows.Count).End(xlUp).Offset(1)
Set ar(3) = Range("R" & Rows.Count).End(xlUp).Offset(1)
Set ar(4) = Range("S" & Rows.Count).End(xlUp).Offset(1)

For i = 1 To 4
With ar(i)
.NumberFormat = "HH:mm:ss"
.Value = Controls("DTPicker" & i).Value
End With
Next i

Unload Me
End Sub

elsg
09-17-2014, 11:35 AM
display mensage

compilation error
'Sub' or 'Function' not defined

Kenneth Hobs
09-17-2014, 11:58 AM
Works fine for me. The forum software can be finicky. Check that the Dim line of code is on relative line 2 for that Sub.

elsg
09-17-2014, 01:28 PM
sorry, i mistake.

you are alright!

thank you!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!