如何根据Excel表格中的单元格列表重命名文件夹中的所有图像名称？

您是否曾经面临过根据Excel电子表格中存储的特定数据重命名大量图像文件的挑战性任务？每个文件都需要手动重命名，这既费力又容易出错。幸运的是，利用编程和自动化的力量，有一种更有效的方法来完成这项任务。本教程将逐步指导您完成该过程，向您展示如何根据Excel文件中的单元格列表重命名文件夹中的所有图像。

根据单元格列表重命名文件夹中的所有图像名称

在这里，我们将首先获取工作表上图像的原始名称，然后重命名它们。让我们来看一个简单的过程，了解如何根据Excel中的单元格列表重命名文件夹中的所有图像。

步骤1

考虑任何Excel工作表。

首先，右键单击工作表名称，然后选择“查看代码”以打开VBA应用程序。

右键单击 > 查看代码。

步骤2

然后单击“插入”，选择“模块”，然后将下面的代码复制到文本框中。

插入 > 模块 > 复制。

代码

Sub PictureNametoExcel()
   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:", "Rename All Images", 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运行模块。然后选择一个单元格来放置图像名称，然后单击“确定”。

F5 > 选择单元格 > 确定。

步骤4

然后选择包含图像的文件夹，然后单击“确定”。

选择文件夹 > 确定。

步骤5

然后您将看到原始名称将被放置在工作表上。现在再次在VBA中，单击“插入”，选择“模块”，并将下面的代码复制到文本框中。

插入 > 模块 > 复制。

代码

Sub RenameFile()
   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):", "Rename All Images", xAddress, , , , , 8)
   If xRgS Is Nothing Then Exit Sub
   Set xRgD = Application.InputBox("Select New Names(Single Column):", "Rename All Images", , , , , , 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, "Rename All Images"
   Application.ScreenUpdating = True
End Sub