انتقل إلى المحتوى الرئيسي

كيفية إعادة تسمية جميع أسماء الصور في مجلد وفقًا لقائمة الخلايا في 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 مفتاح لتشغيل الكود ، ويظهر مربع حوار لتذكيرك بتحديد خلية لإخراج قائمة الأسماء. انظر لقطة الشاشة:
قم بإعادة تسمية الصورة في مجلد 1

4. انقر OK ولتحديد المجلد المحدد الذي تريد إدراج أسماء صوره في ورقة العمل الحالية. انظر لقطة الشاشة:
قم بإعادة تسمية الصورة في مجلد 2

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 مفتاح لتشغيل الكود ، وينبثق مربع حوار لتذكيرك بتحديد أسماء الصور الأصلية التي تريد استبدالها. انظر لقطة الشاشة:
قم بإعادة تسمية الصورة في مجلد 3

4. انقر OK، وحدد الأسماء الجديدة التي تريد استبدال أسماء الصور بها في مربع الحوار الثاني. انظر لقطة الشاشة:
قم بإعادة تسمية الصورة في مجلد 4

5. انقر OK، يظهر مربع حوار لتذكيرك باستبدال أسماء الصور بنجاح.
قم بإعادة تسمية الصورة في مجلد 5

6. انقر فوق "موافق" وتم استبدال أسماء الصور بالخلايا الموجودة في الورقة.

قم بإعادة تسمية الصورة في مجلد 6
السهم لأسفل
قم بإعادة تسمية الصورة في مجلد 7

مقالات ذات صلة:

أفضل أدوات إنتاجية المكتب

🤖 مساعد Kutools AI: إحداث ثورة في تحليل البيانات على أساس: التنفيذ الذكي   |  إنشاء التعليمات البرمجية  |  إنشاء صيغ مخصصة  |  تحليل البيانات وإنشاء الرسوم البيانية  |  استدعاء وظائف Kutools...
الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup    VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير    مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا    إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

الوصف


يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
Comments (7)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Thanks for the tip...it was of great help!!
This comment was minimized by the moderator on the site
It doesn't ask me the location of the files, so the script runs in vain and my files aren't being renamed
This comment was minimized by the moderator on the site
СПАСИБО БОЛЬШОЕ! Объединяю два каталога товаров в одни для выгрузки в админку. Все картинки должны быть переименованы в соответствии с ID товара.
Вы сэкономили мне кучу времени и нервов. Спасибо :) Сайт обязательно в закладки.
This comment was minimized by the moderator on the site
Hi, It renames only the first 10 pics of the folder, could you please help me out with the changes for 100 pics. Thanks & Regards
This comment was minimized by the moderator on the site
Hi, edvin.I G Lazar, I have tested the code, it can rename all pictures you list, if it only rename first 10 of the folder, please check what is the picture type, the suffix, in the first code, it just supports to list the pictures(".jpg" ".png" ".img" ".gif" ".ioc" ".bmp"), if your picture is not in the types the code list you can manually add it to the code, like+ InStr(1, xFileName, ".png")
This comment was minimized by the moderator on the site
Hi, i've tried using this however running the 'PictureNametoExcel' macro only returns the first photo file path name. The other photos in the folder wont be listed. Any help would be greatly appreciated.

Side note: I've tested the 'RenameFile' Macro and that works perfectly

Thanks
Sam
This comment was minimized by the moderator on the site
Hi Sam, Select the cell range. I guess this is as a result of you selecting just one cell
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations