تغير اسماء ملفات اكسل متعددة بخطوة واحدة

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

يمكنك استخدام احد طريقتين :

الطريقة الاولى : اذا كان لديك الاسماء الجديدة فى عمود مسلسلة تحت بعضها 

ستستخدم الكود التالى 

وتضعه فى مديول حسب طريقة الشرح فى الفيديو :

()Sub RenameFiles

Dim xDir As String

Dim xFile As String

Dim xRow As Long

(With Application.FileDialog(msoFileDialogFolderPicker

    .AllowMultiSelect = False

If .Show = -1 Then

    (xDir = .SelectedItems(1

("*"  & xFile = Dir(xDir & Application.PathSeparator 

    Do Until xFile = ""

        xRow = 0

        On Error Resume Next

       ( xRow = Application.Match(xFile, Range("A:A"), 0

        If xRow > 0 Then

           _ Name xDir & Application.PathSeparator & xFile As 

            xDir & Application.PathSeparator & Cells(xRow, "B").Value

        End If

        xFile = Dir

    Loop

End If

End With

End Sub

الطريقة الثانية :  تستخدم فى حالة 

اذا لم يكن لديك الاسماء الجديدة فى عمود مسلسلة تحت بعضها 
واذا كان الاسم المراد الاستبدال به موجود فى خلية داخل كل ملف من الملفات المتعددة 
ستستخدم الكود التالى :
وتضعه فى مديول حسب طريقة الشرح بالفيديو :

Sub renam()

Dim path As String

Dim fn As String

path = "C:\Users\Ali\Desktop\"

fn = Range("b2").Value

ActiveWorkbook.SaveCopyAs Filename:=path & fn & ".xlsx"

ActiveWorkbook.Save

ActiveWorkbook.Close

End Sub

 

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

تابعونا على قناة لغة الاكسل