(16-11-15, 09:39 PM)abulayth كتب : السلام عليكم

ان شاء الله تجد طلبك في المرفقات

يعطيك العافية

(20-11-15, 07:21 PM)Ahmed_Mansoor كتب : أهلا أخي الكريم سالم , لقد عملت لك دالة خاصه لعمل ذلك في مشاركة سابقة ألم تعمل معك , هذه هي الدالة :

كود :

Private Function Check_Time(zMask As String, zTime As String) As Boolean

Dim Dots_Pos() As Integer
Dim Spaces_Pos() As Integer
Dim Char_Pos As Integer
Dim Dots_Count As Integer
Dim Spaces_Count As Integer
Dim zTestTime As String
Dim I As Integer, N As Integer

If Trim$(zMask) = "" Or Trim$(zTime) = "" Or Len(zMask) <> Len(zTime) Then
  Check_Time = False
  Exit Function
End If

Char_Pos = -1

For I = 1 To Len(zMask)

   If Mid$(zMask, I, 1) = ":" Then
      Dots_Count = Dots_Count + 1
      ReDim Preserve Dots_Pos(1 To Dots_Count) As Integer
      Dots_Pos(Dots_Count) = I
   End If
   
   If Mid$(zMask, I, 1) = " " Then
      Spaces_Count = Spaces_Count + 1
      ReDim Preserve Spaces_Pos(1 To Spaces_Count) As Integer
      Spaces_Pos(Spaces_Count) = I
   End If
   
   If Mid$(zMask, I, 1) = "ص" Or Mid$(zMask, I, 1) = "م" Then
      Char_Pos = I
   End If
   
Next

If Dots_Count = 0 And Spaces_Count = 0 And Char_Pos = -1 Then
 
  Check_Time = IsNumeric(zTime)
  Exit Function

Else

  If Dots_Count > 0 Then
 
     For I = LBound(Dots_Pos) To UBound(Dots_Pos)
         If Mid$(zTime, Dots_Pos(I), 1) <> ":" Then
            Check_Time = False
            Exit Function
         End If
     Next
     
  End If
 
  If Spaces_Count > 0 Then
 
     For I = LBound(Spaces_Pos) To UBound(Spaces_Pos)
         If Mid$(zTime, Spaces_Pos(I), 1) <> " " Then
            Check_Time = False
            Exit Function
         End If
     Next
     
  End If
 
  If Char_Pos > -1 Then
     If Mid$(zTime, Char_Pos, 1) <> "ص" And Mid$(zTime, Char_Pos, 1) <> "م" Then
        Check_Time = False
        Exit Function
     Else
        If Char_Pos = 1 Then
           zTestTime = Mid$(zTime, 2)
        ElseIf Char_Pos = Len(zTime) Then
           zTestTime = Left$(zTime, Len(zTime) - 1)
        End If
        zTime = zTestTime
     End If
     
  End If
 
  zTime = Replace$(zTime, ":", "")
  zTime = Replace$(zTime, " ", "")
 
  Check_Time = IsNumeric(zTime)
  Exit Function
 
End If

End Function

وطريقة إستخدامها لفحص الوقت المدخل في صندوق النص بهذه الطريقة :

كود :

If Check_Time("##:## " & "م", Text1.Text) Then
  MsgBox "الوقت صحيح"
Else
  MsgBox "الوقت خطأ"
End If

أو

كود :

If Check_Time("##:##", Text1.Text) Then
  MsgBox "الوقت صحيح"
Else
  MsgBox "الوقت خطأ"
End If

أو

كود :

If Check_Time("##:## " & "م", Text1.Text) Then
  MsgBox "الوقت صحيح"
Else
  MsgBox "الوقت خطأ"
End If

أو

كود :

If Check_Time("م" & " ##:##", Text1.Text) Then
  MsgBox "الوقت صحيح"
Else
  MsgBox "الوقت خطأ"
End If

على حسب التنسيق الذي تريده , وخذ بعين الإعتبار إذا كنت تريد أن يكون في تنسيق الوقت حرف إما "ص" أو "م" أن يكون يكون إما عن يمين أو يسار التنسيق مفصولا بمسافه , بالتوفيق .