ترتيب اوراق العمل تصاعديا حسب الاسم

[عبد اللطيف سلوم]

السلام عليكم

لو كان عندي ملف اكسل يحتوي على العديد م ناوراق العمل باسماء مختلفة

هل هناك طريقة لترتيب الاوراق ابجديا حسب الاسم ؟؟

 

[Ali Mohamed Ali]

وعليكم السلام -بارك الله فيك أستاذ عبد اللطيف

بالتأكيد هناك ترتيب وكما تشاء سواء تصاعدياً أو تنازلياً -كما بهذا الرابط

https://www.officena.net/ib/topic/33468-هل-يمكن-ترتيب-اسماء-شيت-الاكسيل-ابجدي/

وهذا هو الملف

 

ترتيب الأوراق حسب أسمائها.xls

[عبد اللطيف سلوم]

صديقي كيف اطبق الامر على ملف العمل الخاص بي

هل يكفي نسخ الزر الخاص بالترتيب ؟؟

نسخت الزر وفعلا تم الترتيب لكن اعطاني رسالة خطأ

[Ali Mohamed Ali]

عليك بفتح مديول جديد ووضع هذا الكود به وربطه بزر

Sub xlSortSheets_Test()
    Dim strWhich    As String
    Dim Which       As Integer
        strWhich = InputBox("لترتيب أسماء الأوراق تصاعدياً أدخل الرقم  1 " & vbNewLine & "لترتيب أسماء الأوراق تنازلياً أدخل الرقم  -1 ", "تحديد طبيعة ترتيب أسماء الأوراق", "1")
    If strWhich = vbNullString Then Exit Sub
    If strWhich = "-1" Or strWhich = "1" Then
        Which = strWhich
        Call xlSortSheets(Which)
        Exit Sub
    End If
    MsgBox "لم تدخل الأرقام المسموح بها لعمل الترتيب" & vbCrLf & "لم يتم ترتيب الأوراق", vbOKOnly
End Sub
Sub xlSortSheets(Optional Which As Integer = 1)
    Dim I               As Integer
    Dim J               As Integer
    Dim SheetNames()    As String
    Dim temp            As String

    ReDim SheetNames(Sheets.Count)
    For I = 1 To Sheets.Count
        SheetNames(I) = Sheets(I).Name
    Next I

    For I = 1 To Sheets.Count - 1
        For J = I + 1 To Sheets.Count
            If (Which = -1 And SheetNames(I) < SheetNames(J)) _
                    Or _
               (Which = 1 And SheetNames(I) > SheetNames(J)) Then
                    temp = SheetNames(I)
                    SheetNames(I) = SheetNames(J)
                    SheetNames(J) = temp
            End If
        Next J
    Next I
    temp = Sheets(Sheets.Count).Name
    For I = Sheets.Count To 1 Step -1
       Sheets(SheetNames(I)).Select
       Sheets(SheetNames(I)).Move Before:=Sheets(temp)
       temp = SheetNames(I)
    Next I
Sheet1.Select
End Sub

 

[Ali Mohamed Ali]

لو ممكن رفع الملف للتجربة

[عبد اللطيف سلوم]

 

الوزن.xlsx

 

 

[Ali Mohamed Ali]

تفضل عندما تريد ترتيباً تصاعدياً تقوم بكتابة رقم 1 فى الرسالة الحوارية و -1 عندما تريد ترتيباً تنازلياً

 

الوزن.xlsm

[عبد اللطيف سلوم]

الف شكر يا باشا

تم التطبيق بنجاح