مطلوب كود أبجدة وترتيب بشروط معينة

[سيد الأكـرت]

استاذتنا الكرام فضلا من حضراتكم مطلوب كود لأبجدة البنات وآخر للبنون ولكن بشروط معينة وهي عند الضغط على زر بنات يقوم الكود بأبجدة الاسماء بحيث تاتي الاسماء مبأجدة الصف 1 كاملا مرتب بنات اولا ثم بنون ثم الصف الذي يليه رقم 2 وهكذا للنهاية والعكس لو ضغطنا زر بنون تاتي الاسماء مبأجدة الصف 1 كاملا مرتب بنون اولا ثم بنات ثم الصف الذي يليه رقم 2 وهكذا للصف 6 

 

سجل.xls

[lionheart]

The file is not perfect file as it has a lot of formulas that make the file slow. Generally follow the steps accurately to solve the problem of sort

 

First select the shape that has the caption GIRLS and rename the shape from the Name Box to shpGirls

 

Do the same step with the shape of BOYS and rename it to shpBoys

 

Insert new module and paste the code

Sub Sort_By_Boys_Girls()
    Dim shp As Shape, lr As Long, n As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
        Set shp = ActiveSheet.Shapes(Application.Caller)
        If shp.Name = "shpGirls" Then n = 1 Else n = 2
        With ActiveSheet
            lr = .Cells(Rows.Count, "D").End(xlUp).Row
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=Range("F9"), Order:=xlAscending
                .SortFields.Add Key:=Range("I9"), Order:=n
                .SortFields.Add Key:=Range("D9"), Order:=xlAscending
                .SetRange ActiveSheet.Range("D9:AH" & lr)
                .Header = xlNo
                .Apply
            End With
        End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

 Finally assign the macro named [Sort_By_Boys_Girls] to both the shapes

 

[سيد الأكـرت]

اخي الفاضل تم تنفيذ الخطوات لكنه قام بترتيب البنون اولا مع ترتيب الصفوف وكله تمام لكن لم يرتب البنات ولا اعرف ما المشكلة مش حضرتك قلت هختار الكود للزرين بعد اعادة تسميتهم لكن عند الضغط على اي من الزرين يرتب البنون دائما حتى مع زر البنات ومرفق صور لما تم 

تم تعديل يونيو 9, 2023 بواسطه سيد الأكـرت

[lionheart]

Rename the shapes from NAME BOX not the text on the shape

Assign the same macro for both the shapes. I have tried at my side and the code works well

Another point, you haven't execute the macro directly from the visual basic editor

It has to be assigned to a shape

[سيد الأكـرت]

9 ساعات مضت, lionheart said:

 

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