تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
معرفة وعمل Format لرقم هاتف
#1
كاتب الموضوع : AhmedEssawy

هذا المثال على رقم هاتف قياسي للولايات المتحدة الامريكية ، يمكن تعديله ليتناسب مع البلد الذي تحتاج إليه :


كود :
Public Function PhoneFormat(ByVal strPhoneNumber As String) As _
String
Dim strResult As String
Dim iLength As Integer
Dim strExtraChar As String
Dim strOriginal As String
Dim iSpaceResult As Integer
Dim i As Integer

strOriginal = strPhoneNumber

' Remove any style characters from the user input
strPhoneNumber = Replace(strPhoneNumber, ")", "")
strPhoneNumber = Replace(strPhoneNumber, "(", "")
strPhoneNumber = Replace(strPhoneNumber, "-", "")
strPhoneNumber = Replace(strPhoneNumber, ".", "")
strPhoneNumber = Replace(strPhoneNumber, Space(1), "")

iLength = Len(strPhoneNumber)

'convert any letters to numbers
For i = 1 To iLength
Mid$(strPhoneNumber, i, i) = _
PhoneLetterToDigit(Mid$(strPhoneNumber, i, i))
Next i

' now, if any other chars besides numbers exist, return original string to user
For i = 1 To iLength
Select Case Asc(Mid$(strPhoneNumber, i, i))
Case Is < 48, Is > 57
strResult = strOriginal
End Select
Next i

Select Case iLength
' user entered a lot of numbers;only format the first 10
Case Is > 11
If Left$(strPhoneNumber, 1) = "1" Then
strExtraChar = Mid$(strPhoneNumber, 12)
strPhoneNumber = Mid$(strPhoneNumber, 2, 10)
Else
strExtraChar = Mid$(strPhoneNumber, 11)
strPhoneNumber = Mid$(strPhoneNumber, 1, 10)
End If

' if user included the number 1 before the area code.
'We drop this number

Case Is = 11
If Left$(strPhoneNumber, 1) = "1" Then
strPhoneNumber = Mid$(strPhoneNumber, 2)
Else
' check for a space character
iSpaceResult = InStrRev(strOriginal, Space(1))

If iSpaceResult = 0 Then
' we have no idea what they entered
strResult = strOriginal
GoTo Exit_Proc
Else
strExtraChar = Mid$(strPhoneNumber, iSpaceResult)
strPhoneNumber = Mid$(strPhoneNumber, 1, _
iSpaceResult - 1)
End If

End If

Case Is = 10 ' area code and phone
strPhoneNumber = strPhoneNumber
' user did not include an area code; add 3 spaces

Case Is = 7
strPhoneNumber = Space(3) & strPhoneNumber

' unable to figure out what the user typed
' must be an extentsion and not a 'real' phone number
Case Else
strResult = strOriginal
GoTo Exit_Proc

End Select

'Add sytle characters into phone number (format)
strResult = Format(strPhoneNumber, "\(@@@\)\ @@@\-@@@@") & _
Space(1) & strExtraChar

Exit_Proc:
PhoneFormat = strResult

End Function
Function PhoneLetterToDigit(ByVal strPhoneLetter As String) As _
String

Dim intDigit As Integer

intDigit = Asc(UCase$(strPhoneLetter))

If intDigit >= 65 And intDigit <= 90 Then
If intDigit = 81 Or 90 Then ' Q or Z
intDigit = intDigit - 1
End If
intDigit = (((intDigit - 65) \ 3) + 2)
PhoneLetterToDigit = intDigit
Else
PhoneLetterToDigit = strPhoneLetter
End If
End Function
}}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  دالة معرفة نوع القرص + مثال مرفق !!!!!!!!!! RaggiTech 0 648 17-10-12, 03:27 PM
آخر رد: RaggiTech
  معرفة الاجهزة التي تعمل على الشبكة ping + mac address RaggiTech 0 928 17-10-12, 03:24 PM
آخر رد: RaggiTech
  معرفة الاجهزة التي تعمل على الشبكة ping RaggiTech 0 564 17-10-12, 03:23 PM
آخر رد: RaggiTech
  معرفة المساحة الفارغة في القرص -- Api RaggiTech 0 428 17-10-12, 02:54 PM
آخر رد: RaggiTech
  معرفة لغة العرض الخاصة بنظام التشغيل ويندوز RaggiTech 0 354 17-10-12, 02:24 PM
آخر رد: RaggiTech
  معرفة وجود كرت صوت ملحق بالجهاز أم لا RaggiTech 0 354 17-10-12, 01:09 AM
آخر رد: RaggiTech
  معرفة مستوى الصوت المعرف في الويندوز وتغييره RaggiTech 0 269 17-10-12, 01:09 AM
آخر رد: RaggiTech
  معرفة لون النقطة التي يمر بها الماوس حالياً RaggiTech 0 400 17-10-12, 01:08 AM
آخر رد: RaggiTech
  معرفة عنوان النافذة النشطة الآن RaggiTech 0 381 17-10-12, 01:08 AM
آخر رد: RaggiTech
  معرفة عدد الكلمات ضمن نص معين RaggiTech 0 485 17-10-12, 01:08 AM
آخر رد: RaggiTech

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم