Note: The other languages of the website are Google-translated. Back to English
Войти  \/ 
x
or
x
Регистрация  \/ 
x

or

Как переименовать все изображения в папке в соответствии со списком ячеек в Excel?

Вы когда-нибудь пробовали переименовывать изображения в соответствии со списком ячеек на листе? Если да, есть ли у вас какие-нибудь уловки, чтобы быстро справиться с работой, не переименовывая их по очереди? В этой статье я представлю два кода VBA, чтобы быстро справиться с этой задачей в Excel.

Переименовать имена всех изображений в папке


Переименовать имена всех изображений в папке

Чтобы переименовать все имена изображений в указанной папке, вы должны сначала указать исходные имена на листе.

1. Нажмите Alt + F11 ключи для включения Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > модуль и вставьте ниже код в скрипт.

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, ".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. Нажмите Вставить > модуль и вставьте ниже код в скрипт.

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 переименовать картинку в папке 7

Относительные статьи:


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office / Excel 2007-2019 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Sam Jones · 2 years ago
    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
    • To post as a guest, your comment is unpublished.
      Dunmoye · 11 months ago
      Hi Sam, Select the cell range. I guess this is as a result of you selecting just one cell