ملف تغيير اسماء ملفات وورد دفعة واحدة

[أبو قاسم]

الملف المرفق يوجد بة الكود ومثال ولكن لايعمل على ملفات وورد 

تسمية الملفات.xlsm

[أبو قاسم]

فقط يضبط على الملفات اللغة الإنجليزية اللغة العربية مايضبط نرجو حل  لتقبل اللغة العربية

[محي الدين ابو البشر]

جرب هذا

Sub Oval1_Click()
Dim xDir As String
Dim xFile As String
Dim xRow As Long
 With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Please select the files"
        .Filters.Clear
        .Filters.Add "All supported files", "*.*"
If .Show = -1 Then
    xDir = .SelectedItems(1)
    xFile = Dir(xDir & Application.PathSeparator & "*.docx")
    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

 

[abdelfattahbadawy]

ممكن ده يظبط معاك برضوا

 

Rename Files.xlsm