كيفية إعادة تسمية جميع أسماء الصور في مجلد وفقًا لقائمة الخلايا في Excel؟
هل سبق لك أن حاولت إعادة تسمية الصور وفقًا لقائمة الخلايا في الورقة؟ إذا كان الأمر كذلك ، فهل لديك أي حيل للتعامل مع الوظيفة بسرعة دون إعادة تسميتها واحدة تلو الأخرى؟ في هذه المقالة ، أقدم رمزين من رموز VBA للتعامل بسرعة مع هذه المهمة في Excel.
أعد تسمية جميع أسماء الصور في مجلد
أعد تسمية جميع أسماء الصور في مجلد
لإعادة تسمية جميع أسماء الصور في مجلد محدد ، يجب عليك إدراج الأسماء الأصلية في الورقة أولاً.
1. صحافة ALT + F11 مفاتيح لتمكين ميكروسوفت فيسوال باسيك للتطبيقات نافذة.
2. انقر إدراج > وحدة ولصق الكود أدناه في البرنامج النصي.
فبا: احصل على أسماء صور لمجلد
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. انقر OK ولتحديد المجلد المحدد الذي تريد إدراج أسماء صوره في ورقة العمل الحالية. انظر لقطة الشاشة:
5. انقر OK. تم إدراج أسماء الصور في الورقة النشطة.
ثم يمكنك إعادة تسمية الصور.
1. صحافة ALT + F11 مفاتيح لتمكين ميكروسوفت فيسوال باسيك للتطبيقات نافذة.
2. انقر إدراج > وحدة ولصق الكود أدناه في البرنامج النصي.
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 Sub
3. صحافة F5 مفتاح لتشغيل الكود ، وينبثق مربع حوار لتذكيرك بتحديد أسماء الصور الأصلية التي تريد استبدالها. انظر لقطة الشاشة:
4. انقر OK، وحدد الأسماء الجديدة التي تريد استبدال أسماء الصور بها في مربع الحوار الثاني. انظر لقطة الشاشة:
5. انقر OK، يظهر مربع حوار لتذكيرك باستبدال أسماء الصور بنجاح.
6. انقر فوق "موافق" وتم استبدال أسماء الصور بالخلايا الموجودة في الورقة.
مقالات ذات صلة:
أفضل أدوات إنتاجية المكتب
عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت. انقر هنا للحصول على الميزة التي تحتاجها أكثر...
يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير
- تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
- فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
- يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!