تغيير اسم الملف

[خالد الشاعر]

السادة الخبراء

 

لى سؤال لو تسمحو لى

 

هل ممكن ان نغير اسم الملف بكود و الملف مفتوح

 

وشكرا

 

جزاكم الله كل خير

[دغيدى]

تفضل أخى الكريم

من أعمال العلامة الأخ /عبد الله باقشير

غير اسم الملف من الخلية B2

55555.rar

[خالد الشاعر]

اشكرك استاذ دغيدى

 

ولكن الملف لا يفتح معى

 

هل ممكن اعادة الاسال مرة اخرى

 

جزاك الله كل الشكر

[دغيدى]

تفضل

66666.rar

[أم عبد الله]

أستاذنا الكبير عميد منتدنا  / جمال دغيدي

 

السلام عليكم ورحمة الله وبركاته

 

جزاك الله خيراً لك كل الشكر ولأستاذنا القدير / عبد الله باقشير كل الشكر والتحية على هذه الروائع المفيدة . دمتم لنا وجعل جميع اعمالكم في ميزان حسناتكم.

[دغيدى]

الفضلة دوما / ام عبد الله

 

جزاكم الله خير والأخ القدير / عبد الله باقشير 

[عبدالله باقشير]

السلام عليكم

جزاكم الله خيرا

 

هذا كود يعمل على اي امتداد

Option Explicit
'======================================================
'======================================================



Sub RenameMe()
Dim NewName As String, MyBook As String, MyPath As String, MyTyp As String, MyName As String
'============================
On Error GoTo Err_kh_Name
'============================
1:
NewName = InputBox("ادخل اسم الملف الجديد", "اسم الملف")
If StrPtr(NewName) = 0 Then Exit Sub
If Trim(NewName) = "" Then GoTo 1
'============================
With ThisWorkbook
    MyBook = .Name
    MyPath = .Path & Application.PathSeparator
End With

MyTyp = Mid$(MyBook, InStrRev(MyBook, "."))
MyName = Replace(MyBook, MyTyp, "")
'============================
If NewName = MyName Then
    MsgBox "اسم الملف هذا هو نفس الاسم الحالي", vbOKOnly, ""
    GoTo 1
End If
'============================
NewName = MyPath & NewName & MyTyp

If Dir(NewName, vbDirectory) = vbNullString Then
    ThisWorkbook.SaveAs Filename:=NewName
    Kill MyPath & MyBook
    MsgBox "تم تعديل اسم الملف بنجاح", vbOKOnly, "الحمدلله"
Else
    MsgBox "اسم الملف هذا موجود مسبقا", vbOKOnly, ""
    GoTo 1
End If
'============================
Err_kh_Name:
If Err Then
    MsgBox "Err.Number : " & Err.Number
    Err.Clear
End If

End Sub

المرفق 2003

vvv.rar

[الـعيدروس]

السلام عليكم

الاستاذ القدير دغيدي 

جزاك الله خير على هذا الملف

 

 

الاستاذ العلامه عبدالله باقشير حفظك الله

حقيقة كود جميل جدا

جزاك الله كل خير وبارك فيك

 

تقبلو مروري

[دغيدى]

الأخ الكريم / عبدالله باقشير

سلام الله عليكم

هكذا نرى منكم كرم العلم وفقكم الله

[إبراهيم ابوليله]

الاخ دغيدى

كود جميل

بارك الله فيك

[إبراهيم ابوليله]

الاستاذ عبدالله باقشير

كود اكثر من رائع

بارك الله فيك

[خالد الشاعر]

استاذى القدير عبد الله باقشير

الف شكر

و جزاك الله كل خير

 

و الشكر ايضا للاستاذ دغيدى

 

جزاك الله كل شكر

[next]

بصراعة عمل رائع جزاك الله خيرا