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

ms excelmicrosoft technologiesadvanced excel function更新于 2025/3/30 13:32:17

您是否曾面临过一项颇具挑战性的任务:根据 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