ما سبب عدم عمل هذا الكود بكل أنواع الأوفيس والويندوز

[أبو يوسف النجار]

لدي كود لترتيب الطلبة في شيت معين حسب الاسم والنوع والصف وهو يعمل بأوفيس 2016 وهو 32 بت والويندوز 10 عندي ولكن عند بعض الزملاء لا يعمل وهو كود مهم جدا لبرنامجج مهم وآسف لعدم ارفاق الملف لصعوبة ذلك ولكن الكود مرفق والملف  

أرجو من الخبراء معرفة السبب فممكن من الكود يظهر السبب 

الكود 

Sub ترتيبي()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

On Error Resume Next
Prompt = "إذا أردت الإستمرار فانتظر لأن الترتيب يأخذ بعض الوقت "
Command_buttons = vbYesNo + VbMsgBoxRt1Reading
Title = "هل تريد ترتيب البيانات بعد التغيرات الجديدة ؟؟ "
project = MsgBox(Prompt, Command_buttons, Title)
If project = vbYes Then

    ActiveWorkbook.Worksheets("master").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("master").Sort.SortFields.Add2 Key:=Range( _
        "BV8:BV6053"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("master").Sort.SortFields.Add2 Key:=Range( _
        "BT8:BT6053"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("master").Sort.SortFields.Add2 Key:=Range( _
        "C8:C6053"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("master").Sort
        .SetRange Range("B8:BW6053")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

    End With
     
     
Call MsgBox(" تم الترتيب بنجاح ", mBox, "الحمد لله ")
 Application.ScreenUpdating = False
End If

End Sub

ولكم جزيل الشكر 

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

الكود صحيح ما دام يعمل على بعض الأجهزة

ولا علاقة له بنسخة 64 أو 32

ولكن به بعض من عدم الترتيب

جرب هذا التعديل في ترتيب الأكواد

Sub ترتيبي()
Prompt = "إذا أردت الإستمرار فانتظر لأن الترتيب يأخذ بعض الوقت "
Command_buttons = vbYesNo + VbMsgBoxRt1Reading
Title = "هل تريد ترتيب البيانات بعد التغيرات الجديدة ؟؟ "
project = MsgBox(Prompt, Command_buttons, Title)
If project = vbYes Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    With ActiveWorkbook.Worksheets("master").Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("BV8:BV6053"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= xlSortNormal
        .SortFields.Add2 Key:=Range("BT8:BT6053"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= xlSortNormal
        .SortFields.Add2 Key:=Range("C8:C6053"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= xlSortNormal
        .SetRange Range("B8:BW6053")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With  
Call MsgBox(" تم الترتيب بنجاح ", mBox, "الحمد لله ")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub

بالتوفيق 

[أبو يوسف النجار]

تظهر رسالة خطأ 438

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

الخطأ في الكود الأصلي 

أنا فقط قمت بإعادة ترتيب أوامره

في أي سطر يظهر الخطأ؟ 

[أبو يوسف النجار]

تم حذف هذا السطر وهذا السطر يحذف صف خالي من البيانات ثم يعيد الترتيب للطلبة 

.SortFields.Clear

 

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

جرب أن تحذف هذا السطر 

فهو لحذف عمليات الترتيب السابقة 

 

[lionheart]

Sub Test()
    Dim Command_Buttons, ws As Worksheet, Prompt As String, Title As String, Project As Integer
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
        Set ws = ActiveWorkbook.Worksheets("Master")
        Prompt = "Sort Will Take Some Time. Please Wait"
        Command_Buttons = vbYesNo + vbMsgBoxRtlReading
        Title = "Do You Want To Sort After The Recent Changes?"
        Project = MsgBox(Prompt, Command_Buttons, Title)
        If Project = vbYes Then
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("BV8"), Order:=xlAscending
                .SortFields.Add Key:=Range("BT8"), Order:=xlDescending
                .SortFields.Add Key:=Range("C8"), Order:=xlAscending
                .SetRange Range("B8:BW6053")
                .Header = xlYes
                .Apply
            End With
        End If
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Call MsgBox("Sort Done", , "Thanks Allah")
End Sub

 

[أبو يوسف النجار]

بسم الله ما شاء الله عليك أكرمك الله يا أستاذ محمد  لا أملك رد أفضل من جزاكم الله خيرا 

الكود يعمل بكفاءة  ولله الفضل والمنه 

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

جميعا بإذن الله

أنا ما فعلت شيئا سوى ضبط بعض الجمل في ترتيبها

حتى الزميل قلب الأسد قام بتعريف المتغيرات واختصار بعض السطور فقط

بالتوفيق