Hvordan omdøber jeg alle billednavne i en mappe i henhold til en liste over celler i Excel?
Har du nogensinde prøvet at omdøbe billeder i henhold til en liste over celler i arket? Hvis ja, har du nogle tricks til hurtigt at håndtere jobbet uden at omdøbe dem en efter en? I denne artikel introducerer jeg to VBA-koder for hurtigt at håndtere dette job i Excel.
Omdøb alle billednavne i en mappe
Omdøb alle billednavne i en mappe
For at omdøbe alle billednavne i en specificeret mappe skal du først anføre de originale navne i arket.
1. Trykke Alt + F11 for at aktivere Microsoft Visual Basic til applikationer vindue.
2. klik indsatte > Moduler og indsæt nedenstående kode i scriptet.
VBA: Få billednavne på en mappe
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. Trykke F5 tast for at køre koden, og der vises en dialogboks, der minder dig om at vælge en celle, der skal udskrive navnelisten. Se skærmbillede:
4. klik OK og for at vælge den angivne mappe, hvis billednavne skal vises i det aktuelle regneark. Se skærmbillede:
5. klik OK. Billednavne er anført på det aktive ark.
Derefter kan du omdøbe billederne.
1. Trykke Alt + F11 for at aktivere Microsoft Visual Basic til applikationer vindue.
2. klik indsatte > Moduler og indsæt nedenstående kode i scriptet.
VBA: Få omdøb billeder
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. Trykke F5 tast for at køre koden, og der vises en dialogboks, der minder dig om at vælge de originale billednavne, du vil erstatte. Se skærmbillede:
4. klik OK, og vælg de nye navne, du vil erstatte billednavne inden for den anden dialog. Se skærmbillede:
5. klik OK, vises en dialogboks, der minder dig om, at billednavne er blevet erstattet med succes.
6. Klik på OK, og billednavne er erstattet af cellerne i arket.
Relative artikler:
Bedste kontorproduktivitetsværktøjer
Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid. Klik her for at få den funktion, du har mest brug for...
Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere
- Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
- Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
- Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!