Kako preimenovati vsa imena slik v mapi v skladu s seznamom celic v Excelu?
Ste že kdaj poskušali slike preimenovati glede na seznam celic na listu? Če je odgovor pritrdilen, imate kakšen trik, s katerim lahko hitro opravite delo, ne da bi jih preimenovali enega po enega? V tem članku predstavljam dve kodi VBA za hitro obdelavo tega dela v Excelu.
Preimenujte vsa imena slik v mapi
Preimenujte vsa imena slik v mapi
Če želite preimenovati vsa imena slik v določeni mapi, morate prvotna imena najprej navesti na listu.
1. Pritisnite Alt + F11 tipke, da omogočite Microsoft Visual Basic za aplikacije okno.
2. klik Vstavi > Moduli in prilepite spodnjo kodo v skript.
VBA: Pridobite imena slik v mapi
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. Pritisnite F5 tipko za zagon kode in odpre se pogovorno okno, ki vas opomni, da izberete celico za izpis imenskega seznama. Oglejte si posnetek zaslona:
4. klik OK in izberite določeno mapo, katere imena slik morate navesti na trenutnem delovnem listu. Oglejte si posnetek zaslona:
5. klik OK. Imena slik so navedena na aktivnem listu.
Nato lahko slike preimenujete.
1. Pritisnite Alt + F11 tipke, da omogočite Microsoft Visual Basic za aplikacije okno.
2. klik Vstavi > Moduli in prilepite spodnjo kodo v skript.
VBA: Pridobite preimenovanje slik
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. Pritisnite F5 tipko za zagon kode in odpre se pogovorno okno, ki vas opomni, da izberete izvirna imena slik, ki jih želite zamenjati. Oglejte si posnetek zaslona:
4. klik OKin v drugem pogovornem oknu izberite nova imena, ki jih želite zamenjati. Oglejte si posnetek zaslona:
5. klik OK, odpre se pogovorno okno, ki vas opozori, da so bila imena slik uspešno zamenjana.
6. Kliknite V redu in imena slik so nadomestile celice na listu.
 |
 |
 |
Relativni članki:
Najboljša pisarniška orodja za produktivnost
Napolnite svoje Excelove spretnosti s Kutools za Excel in izkusite učinkovitost kot še nikoli prej. Kutools za Excel ponuja več kot 300 naprednih funkcij za povečanje produktivnosti in prihranek časa. Kliknite tukaj, če želite pridobiti funkcijo, ki jo najbolj potrebujete...
Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo
- Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
- Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
- Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
