تحول الارقام في التكست بوكس من الانجليزية الى العربية

[محمد عدنان]

السلام عليكم و رحمة الله و بركاته 

ارجو المساعدة بماكرو يجبر الفورم باظهار الارقام الموجودة في التكس بوك جميعها  1و2و3و4  الى الارقام العربية   دون  الحاجة الى الذهاب الى كنترول بانل و اللغات 

مرفق صورة الى الارقام الانجلزية بحاجة الى تحول الى ارقام الهندية

و شكرا 

 

mark.xlsm

[أبومروان]

وعليكم السلام ورحمه الله

يمكنك استخدام التالي لتحويل أي نص من الأحرف (الإنجليزية على سبيل المثال) إلى أحرف عربية:

Function ConvertNumbersToArabic(ByVal strInput As String) As String
    Dim ch As String
    Dim Result As String
    Dim i As Integer
    Result = ""
    For i = 1 To Len(strInput)
        ch = Mid$(strInput, i, 1)
        Select Case ch
            Case "0"
                Result = Result & "٠"
            Case "1"
                Result = Result & "١"
            Case "2"
                Result = Result & "٢"
            Case "3"
                Result = Result & "٣"
            Case "4"
                Result = Result & "٤"
            Case "5"
                Result = Result & "٥"
            Case "6"
                Result = Result & "٦"
            Case "7"
                Result = Result & "٧"
            Case "8"
                Result = Result & "٨"
            Case "9"
                Result = Result & "٩"
            Case Else
                Result = Result & ch
        End Select
    Next i
    ConvertNumbersToArabic = Result
End Function

يمكنك استدعاء هذه الدالة على سبيل المثال على النحو التالي

 

TextBox1.Value = ConvertNumbersToArabic(TextBox1.Value)

 

 

 

[محمد عدنان]

السلام عليكم 

اخ @كريم نظيم جزاك الله  خير  لكن الكود الي في اعلى لم يعمل و ذلك عند نسح الكود الارقام العربية تتحول الى ؟ علامة 

[lionheart]

In standard module

Function ConvertToArabicNumber(ByVal num As String) As String
    Dim s As String, d As String, i As Long
    For i = 1 To Len(num)
        d = Mid(num, i, 1)
        s = s & ChrW(&H660 + Val(d))
    Next i
    ConvertToArabicNumber = s
End Function

 

In the userform module modify the following procedure

Private Sub ListBox1_Click()
    For i = 0 To ListBox1.ListCount
        If ListBox1.Selected(i) = True Then
            For j = 1 To 61
                Controls("TextBox" & j).Text = ConvertToArabicNumber(Cells(ListBox1.List(i, 1), j))
            Next j
            r = ListBox1.List(i, 1)
            Exit For
        End If
    Next i
End Sub

 

[lionheart]

Another solution

Format the numbers on the worksheet with the following custom format

[$-,201]0

 

then modify this line

Controls("TextBox" & j).Text = Cells(ListBox1.List(i, 1), j).Text

 

[محمد عدنان]

السلام عليكم 

الاستاذ الكبير @lionheart  بارك الله فيك و جزاك الله كل خير 

الكود يعمل على جميع التكست بوك التي تحتوي على ارقام و لكن  التكست بوكس التي تحتوي على اسماء يظهر على شكل نقاط كما في الصورة المرفقة 

[alliiia]

السلام عليكم
أخي الكريم
غير إعدادت جهاز الكمبيوتر

 

من خلال الضغط على إعداد التاريخ بالأسفل

اذهب إلى إعدادت Region 

ثم إلى
Administrative
ثم آخر شيء تحت
change system local
تأكد أنه بالعربي
ولا تحط علامة صح على المربع 

 

وراح يضبط معك حتى لو بدون الأكواد التي تفضلوا بها الأساتذة الكرام

[محمد عدنان]

السلام عليكم 

الاستاذ @alliiia اشكر اهتمامك   الحل الذي ذكرته اعرفة و لكن عتد نقل الملف الى جهاز في مكان اخر لا املك الصلاحية او الاذت لتغيير صيغة الارقام 

انا بحاجة لماكرو يقوم بتغيير الارقام لملفي دون تغيير ارقام الجهاز الحاسوب 

حل الاستاذ @lionheart حول الارقام مثل ما هو مطلوب لكم التكستبوكس التي تحتوي اسماء تظهر على شكل نقط