Excel - formato de fecha en cuadro de texto

como puedo dar formato a un cuadro de texto para introducir una fecha? " / / "

Mira en
http://www.lawebdelprogramador.com/news/mostrar_new.php?id=127&texto=Excel&n1=394612&n2=1&n3=0&n4=0&n5=0&n6=0&n7=0&n8=0&n9=0&n0=0

JLG

No está terminado, depurado ni nada...
Lo hice hoy exclusivamente...
Por ahí te sirve para empezar...
Si lo mejorás o le encontrás errores (seguro tiene) x favor avisame...

NOTA:
Poner en un UserForm un Label (yo lo hice con dos) y un TextBox llamado tb

Option Explicit

Private bSalir As Boolean

Private Sub tb_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim s$, d$, m$, a$, t$
On Error Resume Next
If bSalir Then Exit Sub
s = tb.Text
s = VBA.Replace(s, "_", "")
tb.Text = s
d = Format(Mid(s, 1, InStr(1, s, "/", vbTextCompare) - 1), "00")
t = Mid(s, InStr(1, s, "/", vbTextCompare) + 1)
m = Format(Mid(t, 1, InStr(1, t, "/", vbTextCompare) - 1), "00")
a = Format(Mid(s, InStrRev(s, "/", -1, vbTextCompare) + 1), "00")
If a = "" Then
a = "00"
tb.Text = tb.Text & "00"
End If
Cancel = Len(s) < 4 Or (Not EsFecha(d, m, a))
If Cancel Then
d = IIf(d = "", "__", d)
m = IIf(m = "", "__", m)
a = IIf(a = "", "__", a)
tb.Text = d & "/" & m & "/" & a
tb.SelStart = 0
'MsgBox "Fecha no válida!", vbCritical
Label2.Caption = "Fecha no válida!"
Else
tb.Text = Format(tb.Text, "dd/mm/yy")
'MsgBox CDate(tb.Text)
Label2.Caption = Format(CDate(tb.Text), "Long Date")
End If
End Sub

Private Sub tb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim s$, t$, p%, c$, n%
On Error Resume Next
If KeyCode = VBA.vbKeyReturn Then
Select Case tb.SelStart
Case 0, 1, 2: tb.SelStart = IIf(tb.SelLength > 1, 0, 3)
Case 3, 4, 5: tb.SelStart = IIf(tb.SelLength > 1, 3, 6)
Case Is >= 6: Exit Sub
End Select
KeyCode = 0
Exit Sub
End If

If (KeyCode = VBA.vbKeyLeft Or _
KeyCode = VBA.vbKeyRight Or _
KeyCode = VBA.vbKeyUp Or _
KeyCode = VBA.vbKeyDown Or _
KeyCode = VBA.vbKeyHome Or _
KeyCode = VBA.vbKeyTab) Then
Exit Sub
End If

If Not ((KeyCode >= 48 And KeyCode <= 57) Or (KeyCode >= 96 And KeyCode <= 105)) Then
KeyCode = 0
Exit Sub
End If

If KeyCode >= 96 Then KeyCode = KeyCode - 48

If tb.SelLength > 1 Then
Select Case tb.SelStart
Case 0, 1: tb.SelStart = 0
Case 2, 3, 4: tb.SelStart = 3
Case Is >= 5: tb.SelStart = 6
End Select
tb.SelLength = 0
End If

t = tb.Text
p = tb.SelStart

If p = 2 Or p = 5 Then p = p + 1

If Len(t) = 8 And p = 8 Then Exit Sub
c = Chr(KeyCode)
s = Mid(t, 1, p) & c & Mid(tb.Text, p + 2)

If p = 1 Then
n = CInt(Mid(s, 1, 2))
If n > 31 Or n <= 0 Then
tb.SelStart = 0
tb.SelLength = 1
Exit Sub
End If
End If

If p = 4 Then
n = CInt(Mid(s, 4, 2))
If n > 12 Or n <= 0 Then
tb.SelStart = 3
tb.SelLength = 1
Exit Sub
End If
End If

tb.Text = s
tb.SelStart = IIf(p = 1 Or p = 4, p + 2, p + 1)
End Sub

Private Sub UserForm_Initialize()
bSalir = False
tb.Text = "__/__/__"
tb.SelStart = 0
End Sub

Private Function EsFecha(ByVal iDay As String, ByVal iMonth As String, ByVal iYear As String) As Boolean
Dim LastDateMonth As Date
EsFecha = False
If iDay = "" Or iMonth = "" Or iYear = "" Then Exit Function
If CInt(iDay) > 31 Or CInt(iMonth) > 12 Then Exit Function
If CInt(iDay) <= 0 Or CInt(iMonth) <= 0 Or CInt(iYear) < 0 Then Exit Function
If Not IsDate(iDay & "/" & iMonth & "/" & iYear) Then Exit Function
LastDateMonth = Day(DateSerial(CInt(iYear), CInt(iMonth) + 1, 1) - 1)
EsFecha = CInt(iDay) <= LastDateMonth
End Function

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
bSalir = True
End Sub

Saludos desde Baires, JuanC

gracias por vuestro interes pero de momento no funciona estoy haciendo alguna prueba. Un saludo

Me podrías decir qué o por qué no funciona?? Intentaste depurarlo??

Saludos desde Baires, JuanC