Bir klasördeki tüm resim adlarını Excel'deki hücre listesine göre nasıl yeniden adlandırabilirim?
Sayfadaki hücre listesine göre resimleri yeniden adlandırmayı hiç denediniz mi? Öyleyse, işi tek tek yeniden adlandırmadan hızlı bir şekilde halletmek için herhangi bir püf noktanız var mı? Bu makalede, bu işi Excel'de hızlı bir şekilde halletmek için iki VBA kodu tanıtıyorum.
Bir klasördeki tüm resim adlarını yeniden adlandırın
Bir klasördeki tüm resim adlarını yeniden adlandırın
Belirli bir klasördeki tüm görüntü adlarını yeniden adlandırmak için, ilk olarak sayfada orijinal adları listelemelisiniz.
1. Basın Alt + F11 etkinleştirmek için anahtarlar Uygulamalar için Microsoft Visual Basic pencere.
2. tık Ekle > modül ve aşağıdaki kodu komut dosyasına yapıştırın.
VBA: Bir klasörün resim adlarını alın
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. Basın F5 kodu çalıştırmak için tuşuna basın ve ad listesinin çıktısını almak için bir hücre seçmenizi hatırlatan bir iletişim kutusu açılır. Ekran görüntüsüne bakın:
4. tık OK ve resim adlarını geçerli çalışma sayfasında listelemeniz gereken belirtilen klasörü seçmek için. Ekran görüntüsüne bakın:
5. tık OK. Resim isimleri aktif sayfada listelenmiştir.
Ardından resimleri yeniden adlandırabilirsiniz.
1. Basın Alt + F11 etkinleştirmek için anahtarlar Uygulamalar için Microsoft Visual Basic pencere.
2. tık Ekle > modül ve aşağıdaki kodu komut dosyasına yapıştırın.
VBA: Resimleri Yeniden Adlandırın
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. Basın F5 kodu çalıştırmak için tuşuna basın ve değiştirmek istediğiniz orijinal resim adlarını seçmenizi hatırlatan bir iletişim kutusu açılır. Ekran görüntüsüne bakın:
4. tık OKve ikinci diyalog içinde resim adlarını değiştirmek istediğiniz yeni adları seçin. Ekran görüntüsüne bakın:
5. tık OK, resim adlarının başarıyla değiştirildiğini size hatırlatmak için bir iletişim kutusu açılır.
6. Tamam'ı tıklayın ve resim adları sayfadaki hücrelerle değiştirildi.
 |
 |
 |
İlgili Makaleler:
En İyi Ofis Üretkenlik Araçları
Kutools for Excel ile Excel Becerilerinizi Güçlendirin ve Daha Önce Hiç Olmadığı Gibi Verimliliği Deneyimleyin. Kutools for Excel, Üretkenliği Artırmak ve Zamandan Tasarruf Etmek için 300'den Fazla Gelişmiş Özellik Sunar. En Çok İhtiyacınız Olan Özelliği Almak İçin Buraya Tıklayın...
Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir
- Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
- Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
- Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
