كيف يمكن إعادة تسمية جميع ملفات الصور في مجلد وفقًا لقائمة الخلايا الموجودة في Excel؟
هل سبق أن احتجتَ إلى إعادة تسمية صور متعددة في مجلد بناءً على قائمة الأسماء الموجودة في ورقة Excel؟ قد تستغرق إعادة تسميتها يدويًّا واحدة تلو الأخرى وقتًا طويلاً، لكن مع أكواد VBA، يمكنك أتمتة العملية بسرعة وسهولة.
إعادة تسمية جميع ملفات الصور في مجلد
إعادة تسمية جميع ملفات الصور في مجلد
لإعادة تسمية جميع ملفات الصور في مجلد محدد، اتبع الخطوات التالية:
الخطوة 1: استيراد أسماء الملفات الأصلية من المجلد إلى ورقة في Excel
1. اضغط على مفاتيح «Alt + F11» لفتح نافذة «Microsoft Visual Basic for Applications».
2. انقر على «Insert» > «Module»، ثم الصق الكود أدناه في النص البرمجي.
VBA: استرجاع أسماء الصور من مجلد
Sub PictureNametoExcel()
'UpdatebyExtendoffice201709027
Dim I As Long
Dim xRg As Range
Dim xAddress As String
Dim xFileName As String
Dim xFileDlg As FileDialog
Dim xFileDlgItem As Variant
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Select a cell to place name list:", "KuTools For Excel", xAddress, , , , , 8)
If xRg Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xRg = xRg(1)
xRg.Value = "Picture Name"
With xRg.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
End With
xRg.EntireColumn.AutoFit
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
I = 1
If xFileDlg.Show = -1 Then
xFileDlgItem = xFileDlg.SelectedItems.Item(1)
xFileName = Dir(xFileDlgItem & "\")
Do While xFileName <> ""
If InStr(1, xFileName, ".jpg") + InStr(1, xFileName, ".png") + InStr(1, xFileName, ".img") + InStr(1, xFileName, ".gif") + InStr(1, xFileName, ".ioc") + InStr(1, xFileName, ".bmp") > 0 Then
xRg.Offset(I).Value = xFileDlgItem & "\" & xFileName
I = I + 1
End If
xFileName = Dir
Loop
End If
Application.ScreenUpdating = True
End Sub
3. اضغط مفتاح "F5" لتشغيل الكود، وستظهر لك نافذة منبثقة لتذكيرك باختيار خلية لإخراج قائمة الأسماء. راجع لقطة الشاشة:
4. انقر على «موافق»، ثم اختر المجلد المحدد الذي ترغب في سرد أسماء صوره ضمن ورقة العمل الحالية. راجع لقطة الشاشة:
5. انقر على «موافق». سيتم سرد أسماء الصور في ورقة العمل الحالية.
الخطوة 2: إعادة تسمية ملفات الصور استنادًا إلى قائمة الأسماء جديد
1. اضغط على مفاتيح «Alt + F11» لفتح نافذة «Microsoft Visual Basic for Applications».
2. انقر على «Insert» > «Module»، ثم الصق الكود أدناه في النافذة البرمجية.
VBA: إعادة تسمية ملفات الصور في مجلد
Sub RenameFile()
'UpdatebyExtendoffice20170927
Dim I As Long
Dim xLastRow As Long
Dim xAddress As String
Dim xRgS, xRgD As Range
Dim xNumLeft, xNumRight As Long
Dim xOldName, xNewName As String
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRgS = Application.InputBox("Select Original Names(Single Column):", "KuTools For Excel", xAddress, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Select New Names(Single Column):", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
Application.ScreenUpdating = False
xLastRow = xRgS.Rows.Count
Set xRgS = xRgS(1)
Set xRgD = xRgD(1)
For I = 1 To xLastRow
xOldName = xRgS.Offset(I - 1).Value
xNumLeft = InStrRev(xOldName, "\")
xNumRight = InStrRev(xOldName, ".")
xNewName = xRgD.Offset(I - 1).Value
If xNewName <> "" Then
xNewName = Left(xOldName, xNumLeft) & xNewName & Mid(xOldName, xNumRight)
Name xOldName As xNewName
End If
Next
MsgBox "Congratulations! You have successfully renamed all the files", vbInformation, "KuTools For Excel"
Application.ScreenUpdating = True
End Sub3. اضغط مفتاح "F5" لتشغيل الكود، وستظهر نافذة منبثقة لتذكيرك باختيار أسماء الصور الأصلية التي ترغب في استبدالها. راجع لقطة الشاشة:
4. انقر على «موافق»، ثم اختر الاسم الجديد الذي تريد استبدال أسماء الصور به في النافذة المنبثقة الثانية. راجع لقطة الشاشة:
5. انقر على «موافق»، وستظهر نافذة منبثقة لتذكيرك بأنه تم استبدال أسماء الصور بنجاح.
6. انقر على «موافق»، وسيتم استبدال أسماء الصور في المجلد بأسماء جديدة من الخلايا في الورقة.
 |
 |
 |
مقالات ذات صلة:
أفضل أدوات الإنتاجية لمكتبتك
عزِّز مهاراتك في Excel باستخدام Kutools لـ Excel، وعايش الكفاءة كما لم تفعل من قبل.يقدّم Kutools لـ Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية ووقت الحفظ.انقر هنا للحصول على الميزة التي تحتاجها أكثر من غيرها...
يجلب Office Tab واجهة ذات علامات تبويب إلى Office، ويجعل عملك أسهل بكثير
- تمكّن من التحرير والقراءة باستخدام علامات التبويب في Word وExcel وPowerPoint، وPublisher وAccess وVisio وProject.
- افتح وأنشئ مستندات متعددة في علامات تبويب جديدة داخل النافذة نفسها، بدلاً من فتح نوافذ جديدة.
- يزيد إنتاجيتك بنسبة 50% ويوفّر لك مئات نقرات الفأرة كل يوم!
جميع الإضافات من Kutools في برنامج تثبيت واحد!
Kutools for Office حزمةٌ تحتوي على إضافاتٍ مخصصة لتطبيقات Excel وWord وOutlook وPowerPoint، إلى جانب Office Tab Pro، مما يجعلها الخيار المثالي للفِرق التي تعمل عبر تطبيقات Office.
- حزمة شاملة واحدة— إضافات Excel وWord وOutlook وPowerPoint بالإضافة إلى Office Tab Pro
- برنامج تثبيت واحد، ترخيص واحد— الإعداد خلال دقائق (جاهز لـ MSI)
- يعمل بشكل أفضل معًا— إنتاجية ميسَّرة عبر تطبيقات Office
- تجربة مجانية لمدة 30 يومًا بكامل الميزات— بدون تسجيل، بدون بطاقة ائتمان
- أفضل قيمة— وفِّر مقارنةً بشراء الإضافات بشكل منفصل