Hoe hernoemt u alle afbeeldingsbestanden in een map op basis van een lijst met cellen in Excel?
Hebt u ooit meerdere afbeeldingen in een map moeten hernoemen op basis van een naamlijst in een Excel-werkblad? Ze één voor één handmatig hernoemen kost veel tijd – maar met een eenvoudig stukje VBA-code automatiseert u dit proces razendsnel.
Hernoem Alle Afbeeldingsbestanden in een map
Hernoem Alle Afbeeldingsbestanden in een map
Volg deze stappen om Alle Afbeeldingsbestanden in een opgegeven map te hernoemen:
Stap 1: Importeer de oorspronkelijke bestandsnamen uit de map naar een werkblad in Excel
1. Druk op Alt + F11 om het venster Microsoft Visual Basic for Applications te openen.
2. Klik op 'Invoegen' > 'Module' en plak de onderstaande code in het script.
VBA: Haal afbeeldingsnamen op uit een map
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. Druk op F5 om de code uit te voeren. Vervolgens verschijnt een dialoogvenster waarin u wordt gevraagd een cel te selecteren voor het weergeven van de Namenlijst. Zie schermafbeelding:
4. Klik op „OK” en selecteer de map waarvan u de afbeeldingsnamen wilt weergeven in het huidige werkblad. Zie schermafbeelding:
5. Klik op „OK”. De afbeeldingsnamen verschijnen nu op het huidige werkblad.
Stap 2: Hernoem de afbeeldingsbestanden op basis van een nieuwe Namenlijst
1. Druk op Alt + F11 om het venster Microsoft Visual Basic for Applications te openen.
2. Klik op 'Invoegen' > 'Module' en plak de onderstaande code in het script.
VBA: Hernoem afbeeldingsbestanden in een map
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 Sub3. Druk op „F5” om de code uit te voeren. Vervolgens verschijnt een dialoogvenster waarin u de oorspronkelijke afbeeldingsnamen kunt selecteren die u wilt vervangen. Zie schermafbeelding:
4. Klik op „OK” en kies in het tweede dialoogvenster de Nieuwe Naam waarmee u de bestaande afbeeldingsnamen wilt vervangen. Zie schermafbeelding:
5. Klik op „OK”. Er verschijnt een bevestigingsdialoogvenster dat de afbeeldingsnamen succesvol zijn vervangen.
6. Klik op „OK” en de bestandsnamen in de map worden automatisch vervangen door de Nieuwe Naam uit de cellen in het werkblad.
 |
 |
 |
Gerelateerde artikelen:
Beste Office-productiviteitshulpmiddelen
Geef uw Excel-vaardigheden een boost met Kutools voor Excel en ervaar efficiëntie zoals nooit tevoren.Kutools voor Excel biedt meer dan 300 geavanceerde functies om de productiviteit te verhogen en Tijd besparen.Klik hier om de functie te krijgen die u het meest nodig heeft...
Office Tab brengt een tabbladinterface naar Office en maakt uw werk veel eenvoudiger
- Schakel tabbladbewerking en -lezen in voor Word, Excel, PowerPoint, Publisher, Access, Visio en Project.
- Open en maak meerdere documenten aan in nieuwe tabbladen binnen hetzelfde venster, in plaats van in afzonderlijke vensters.
- Verhoogt uw productiviteit met 50 % en bespaart u dagelijks honderden muisklikken!
Alle Kutools-add-ins in één installatieprogramma.
Kutools for Office bundelt add-ins voor Excel, Word, Outlook en PowerPoint, plus Office Tab Pro—ideaal voor teams die met meerdere Office-apps werken.
- Alles-in-één suite— add-ins voor Excel, Word, Outlook & PowerPoint plus Office Tab Pro
- Één installatieprogramma, één licentie— binnen enkele minuten klaar (MSI-geschikt)
- Werkt beter samen— gestroomlijnde productiviteit in alle Office-apps
- 30 dagen volledig functionele proefversie— geen registratie, geen creditcard
- Beste prijs-kwaliteitverhouding— bespaar ten opzichte van het afzonderlijk kopen van add-ins