هدية: معالجة الكتابة/ الحروف العربية المشفرة التي تظهر في ملفات إكسل

[Hamdi Edlbi-khalf]

السلام عليكم

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

أقدم لكم هذا الكود الذي كتبته بعد بحث في موضوع اليونيكود خاصة أني سابقاً قد عانيت من المشكلة و الحلول البديلة تسمح بمعرفة المحتوى دون القدرة على تحويل الملف بالكامل.

ملاحظة : يفضل نسخ الملف المشفر قبل إجراء التحويل عليه.

a Code shows invalid/ decrypted characters in Excel properly 

  والحمد لله الذي بنعمته تتم الصالحات و صلى الله على سيدنا محمد وعلى آله وصحبه أجمعين وسلم تسليماً كثيراً.

 

عند فتح الملف هنا زر بالنقر عليه تفتح نافذة لاختيار الملف المطلوب ثم مربع حوار لكتابة اسم الورقة ثم مربع حوار اختيار المجال المراد تغييره عن طريق التحديد.

الفانكشن في البداية يمكن استدعاؤها كدالة من دوال إكسل ضمن ورقة البيانات يكفي لذلك

= InStead(YourText or Cell Address)

Public Function InStead(T1 As String)
' Created by Khalf  Officena Forums 20/02/2020
' www.officena.net
' Hamdi Edlbi
' This Code for Showing  Arabic Characters Properly In Excel
Dim w As Integer
w = Len(T1)
For X = 1 To w
T2 = Mid(T1, X, 1)
T3 = AscW(T2)
T4 = Chr(T3)
 T5 = T5 & T4
 Next X
 InStead = T5
 End Function
Sub InSteadAll()
' This Sub For Call the Function In The Current Sheet
On Error Resume Next
Dim C As Range
For Each C In Selection
C.Value = InStead(C.Value)
Next
End Sub

Sub ChooseRange()
'Choose the Range
Dim rng As Range
Set rng = Application.InputBox("Select The Range", "Decryption Characters", , , , , , 8)
Application.Goto rng
' Call  The Sub InSteadAll
Call InSteadAll
End Sub
Sub OpenWorkbook()

 'Apply The Code to Another Workbook
 On Error Resume Next
    Dim strFile As String
    Dim X As String
    strFile = Application.GetOpenFilename()
    Workbooks.Open (strFile)
    
    ' These Followed Couple of Lines are Optional In Case You Need to Get Specific Sheet
    X = Application.InputBox("Select The Sheet", "Decryption Characters", , , , , , 2)
    Sheets(X).Activate
    
       Call ChooseRange
End Sub

Decryption_Invalid_Characters.xls

[عبدالفتاح في بي اكسيل]

بارك  الله فيك   مزيدا  من العلم  والعطاء 

[Hamdi Edlbi-khalf]

شكراً على تشجيعكم أخي الغالي.

[Ali Mohamed Ali]

أحسنت استاذ خلف جزاك الله كل خير

[Hamdi Edlbi-khalf]

شكراًً لكم بارك الله بكم.

[gamalin2]

جزاك الله خيرا اخانا الكريم حقا هدية قيمة ورائعة بل اكثر من رائعة شكرا لك 

[سيد الأكرت]

طب ممكن بالله عليك ترجعلي الملف ده وانا ادعيلك طول عمري 

sayed.rar

[وليدباعرام]

طريقة تنفيذ هذا الكود

 

[أ / محمد صالح]

يوجد ملف مرفق في المشاركة الأولى به التنفيذ