Bagaimana cara mengganti nama semua nama gambar dalam folder sesuai dengan daftar sel di Excel?
Pernahkah Anda mencoba mengganti nama gambar menurut daftar sel di lembar? Jika ya, apakah Anda punya trik untuk menangani pekerjaan dengan cepat tanpa mengganti namanya satu per satu? Pada artikel ini, saya memperkenalkan dua kode VBA untuk menangani pekerjaan ini dengan cepat di Excel.
Ubah nama semua nama gambar dalam folder
Ubah nama semua nama gambar dalam folder
Untuk mengganti nama semua nama gambar dalam folder tertentu, Anda harus mencantumkan nama asli di lembar terlebih dahulu.
1. tekan Alt + F11 kunci untuk mengaktifkan Microsoft Visual Basic untuk Aplikasi jendela.
2. klik Menyisipkan > Modul dan tempel kode di bawah ini ke skrip.
VBA: Dapatkan nama gambar dari sebuah folder
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. tekan F5 kunci untuk menjalankan kode, dan dialog muncul untuk mengingatkan Anda untuk memilih sel untuk menampilkan daftar nama. Lihat tangkapan layar:
4. klik OK dan untuk memilih folder tertentu yang nama gambarnya perlu Anda cantumkan di lembar kerja saat ini. Lihat tangkapan layar:
5. klik OK. Nama gambar telah terdaftar di lembar aktif.
Kemudian Anda dapat mengganti nama gambar.
1. tekan Alt + F11 kunci untuk mengaktifkan Microsoft Visual Basic untuk Aplikasi jendela.
2. klik Menyisipkan > Modul dan tempel kode di bawah ini ke skrip.
VBA: Dapatkan Ganti Nama Gambar
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. tekan F5 untuk menjalankan kode, dan dialog muncul untuk mengingatkan Anda agar memilih nama gambar asli yang ingin Anda ganti. Lihat tangkapan layar:
4. klik OK, dan pilih nama baru yang ingin Anda ganti nama gambarnya dalam dialog kedua. Lihat tangkapan layar:
5. klik OK, sebuah dialog muncul untuk mengingatkan Anda bahwa nama gambar telah berhasil diganti.
6. Klik OK dan nama gambar telah diganti dengan sel di lembar.
 |
 |
 |
Artikel Relatif:
Alat Produktivitas Kantor Terbaik
Tingkatkan Keterampilan Excel Anda dengan Kutools for Excel, dan Rasakan Efisiensi yang Belum Pernah Ada Sebelumnya. Kutools for Excel Menawarkan Lebih dari 300 Fitur Lanjutan untuk Meningkatkan Produktivitas dan Menghemat Waktu. Klik Di Sini untuk Mendapatkan Fitur yang Paling Anda Butuhkan...
Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah
- Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
- Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
- Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
