Перейти до основного матеріалу
 

Як перейменувати всі імена зображень у папці відповідно до списку комірок у Excel?

Автор: нд Остання зміна: 2022-09-30

Ви коли-небудь пробували перейменовувати зображення відповідно до списку комірок у аркуші? Якщо так, чи є у вас трюки, щоб швидко впоратися із завданням, не перейменовуючи їх по черзі? У цій статті я представляю два коди VBA, щоб швидко обробити цю роботу в Excel.

Перейменуйте всі назви зображень у папці


Перейменуйте всі назви зображень у папці

Щоб перейменувати всі імена зображень у вказаній папці, спочатку потрібно вказати оригінальні імена на аркуші.

1. прес Alt + F11 клавіші, щоб увімкнути Microsoft Visual Basic для додатків вікна.

2. клацання Insert > Модулі і вставте нижче код у сценарій.

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 клавіша для запуску коду, і з'явиться діалогове вікно, щоб нагадати вам вибрати клітинку для виведення списку імен. Дивіться знімок екрана:
doc перейменувати зображення в папці 1

4. клацання OK та вибрати вказану папку, імена зображень якої потрібно перерахувати на поточному аркуші. Дивіться знімок екрана:
doc перейменувати зображення в папці 2

5. клацання OK. Назви зображень вказані на активному аркуші.

Потім ви можете перейменувати картинки.

1. прес Alt + F11 клавіші, щоб увімкнути Microsoft Visual Basic для додатків вікна.

2. клацання Insert > Модулі і вставте нижче код у сценарій.

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 клавіша для запуску коду, і з'явиться діалогове вікно, щоб нагадати вам вибрати оригінальні назви зображень, які потрібно замінити. Дивіться знімок екрана:
doc перейменувати зображення в папці 3

4. клацання OKта виберіть у другому діалозі нові імена, якими ви хочете замінити назви зображень. Дивіться знімок екрана:
doc перейменувати зображення в папці 4

5. клацання OK, спливає діалогове вікно, щоб нагадати вам про те, що назви зображень успішно замінені.
doc перейменувати зображення в папці 5

6. Клацніть OK, і назви зображень замінено клітинками на аркуші.

doc перейменувати зображення в папці 6
doc стрілка вниз
doc перейменувати зображення в папці 7

Відносні статті:

Найкращі інструменти продуктивності офісу

🤖 Kutools AI Aide: Революціонізуйте аналіз даних на основі: Інтелектуальне виконання   |  Згенерувати код  |  Створення спеціальних формул  |  Аналізуйте дані та створюйте діаграми  |  Викликати функції Kutools...
Популярні функції: Знайдіть, виділіть або визначте дублікати   |  Видалити порожні рядки   |  Об’єднайте стовпці або клітинки без втрати даних   |   Раунд без Формули ...
Супер пошук: VLookup за кількома критеріями    Багатозначний VLookup  |   VLookup на кількох аркушах   |   Нечіткий пошук ....
Розширений розкривний список: Швидке створення випадаючого списку   |  Залежний спадний список   |  Виберіть розкривний список, що вибирається ....
Менеджер колонок: Додайте конкретну кількість стовпців  |  Перемістити стовпці  |  Перемкнути статус видимості прихованих стовпців  |  Порівняйте діапазони та стовпці ...
Особливості: Фокус сітки   |  Перегляд дизайну   |   Велика панель формул    Диспетчер робочих книг і аркушів   |  Бібліотека ресурсів (автотекст)   |  Вибір дати   |  Об’єднайте робочі аркуші   |  Шифрування/розшифрування клітинок    Надсилайте листи за списком   |  Супер фільтр   |   Спеціальний фільтр (фільтр жирний/курсив/закреслений...) ...
Топ-15 наборів інструментів12 текст Tools (додати текст, Видалити символи, ...)   |   50 + Графік типи (діаграма Ганта, ...)   |   40+ Практичний Формули (Розрахуйте вік на основі дня народження, ...)   |   19 вставка Tools (Вставте QR-код, Вставити зображення зі шляху, ...)   |   12 Перетворення Tools (Числа до слів, Валютна конверсія, ...)   |   7 Злиття та розділення Tools (Розширені комбіновані ряди, Розділені клітини, ...)   |   ... і більше

Покращуйте свої навички Excel за допомогою Kutools для Excel і відчуйте ефективність, як ніколи раніше. Kutools для Excel пропонує понад 300 додаткових функцій для підвищення продуктивності та економії часу.  Натисніть тут, щоб отримати функцію, яка вам найбільше потрібна...


Вкладка Office Передає інтерфейс із вкладками в Office і значно полегшує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!