السلام عليكم إخواني وأحبابي في الله

أقدم لكم في موضوع اليوم كود كحل لسؤال أحد الأخوة على الفيس بوك



يقوم الكود بتسمية المصنف الحالي الذي يحتوي الكود بناءً على القيمة الموجودة في خلية معينة

وهذا هو الكود

Sub Rename_ActiveWorkbook_By_Cell_Value_Trick()
    Dim sValue As String, wbName As String, newName As String

    sValue = Sheets(1).Range("A1").Value
    If sValue = "" Then MsgBox "Cell Is Empty. The Cell Must Have A Value", vbExclamation: Exit Sub
    
    wbName = ThisWorkbook.FullName
    newName = Mid(wbName, 1, InStrRev(wbName, "")) & sValue & ".xlsm"
    If wbName = newName Then MsgBox "The Workbook Was Already Renamed", vbExclamation: Exit Sub
    
    ActiveWorkbook.SaveAs newName
    Kill wbName
End Sub

شرح الكود:
*******
في السطر الأول إعلان عن مجموعة من المتغيرات من النوع النصي

في السطر التالي تعيين قيمة للمتغير sValue ليساوي قيمة الخلية A1 الموجودة في أول ورقة عمل ، ويمكن تغيير الخلية أو ورقة العمل كما تشاء

في السطر الثالث اختبار قيمة الخلية بحيث لو كانت الخلية فارغة ولا تحتوي على أي قيمة تظهر رسالة تفيد بذلك ويتم الخروج من الإجراء بدون تنفيذ بقية الكود Exit Sub

في السطر الرابع يتم تخزين مسار المصنف الحالي (المسار بالكامل وليس اسم المصنف فقط) وذلك من خلال استخدام ThisWorkbook.FullName

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

في السطر السادس إذا وجد مصنف بنفس الاسم المطلوب التغيير إليه يتم إظهار رسالة تفيد بأن المصنف تمت تسميته ويتم الخروج من الإجراء الفرعي

في السطر السابع يتم حفظ المصنف الحالي بالاسم الجديد في المسار المحدد في الاسم الجديد

ActiveWorkbook.SaveAs newName<br />

وأخيراً يتم حذف المصنف القديم (ذو الاسم القديم) والاحتفاظ بالمصنف ذو الاسم الجديد فقط

وأخيراً أرجو أن يكون الشرح مفيد وواضح لكم إن شاء الله

رابط الملف من هنا

أخوكم في الله / ياسر خليل أبو البراء