Hur byter jag namn på alla bildnamn i en mapp enligt en lista över celler i Excel?
Har du någonsin försökt byta namn på bilder enligt en lista med celler i arket? Om så är fallet, har du några knep för att snabbt hantera jobbet utan att byta namn på dem en efter en? I den här artikeln introducerar jag två VBA-koder för att snabbt hantera detta jobb i Excel.
Byt namn på alla bildnamn i en mapp
Byt namn på alla bildnamn i en mapp
För att byta namn på alla bildnamn i en viss mapp måste du först visa originalnamnen i arket.
1. Tryck Alt + F11 för att aktivera Microsoft Visual Basic för applikationer fönster.
2. klick Insert > Modulerna och klistra in under koden i skriptet.
VBA: Hämta bildnamn på en mapp
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. Tryck F5 för att köra koden och en dialogruta dyker upp för att påminna dig om att välja en cell för att mata ut namnlistan. Se skärmdump:
4. klick OK och för att välja den angivna mappen vars bildnamn du behöver lista i det aktuella kalkylbladet. Se skärmdump:
5. klick OK. Bildnamnen har listats på det aktiva arket.
Då kan du byta namn på bilderna.
1. Tryck Alt + F11 för att aktivera Microsoft Visual Basic för applikationer fönster.
2. klick Insert > Modulerna och klistra in under koden i skriptet.
VBA: Få byta namn på bilder
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. Tryck F5 för att köra koden, och en dialogruta dyker upp för att påminna dig om att välja de ursprungliga bildnamnen du vill ersätta. Se skärmdump:
4. klick OKoch välj de nya namnen du vill ersätta bildnamnen i den andra dialogen. Se skärmdump:
5. klick OK, en dialogruta dyker upp för att påminna dig om att bildnamnen har ersatts med framgång.
6. Klicka på OK och bildnamnen har ersatts med cellerna i arket.
 |
 |
 |
Relativa artiklar:
De bästa Office-produktivitetsverktygen
Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%
- återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
- Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
- Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
- Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
- Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
- Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
- Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
- Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
- Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare
- Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
- Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
- Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
