Como renomear todos os nomes de imagens em uma pasta de acordo com uma lista de células no Excel?
Você já tentou renomear imagens de acordo com uma lista de células na planilha? Em caso afirmativo, você tem algum truque para lidar rapidamente com o trabalho sem renomeá-los um por um? Neste artigo, apresento dois códigos VBA para lidar rapidamente com esse trabalho no Excel.
Renomear todos os nomes de imagens em uma pasta
Renomear todos os nomes de imagens em uma pasta
Para renomear todos os nomes de imagens em uma pasta especificada, você deve primeiro listar os nomes originais na folha.
1. Pressione Alt + F11 chaves para habilitar o Microsoft Visual Basic para Aplicações janela.
2. Clique inserção > Módulo e cole o código abaixo no script.
VBA: obter nomes de imagens de uma pasta
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. Pressione F5 para executar o código e uma caixa de diálogo é exibida para lembrá-lo de selecionar uma célula para gerar a lista de nomes. Veja a imagem:
4. Clique OK e para selecionar a pasta especificada cujos nomes de imagem você precisa listar na planilha atual. Veja a imagem:
5. Clique OK. Os nomes das imagens foram listados na planilha ativa.
Então você pode renomear as fotos.
1. Pressione Alt + F11 chaves para habilitar o Microsoft Visual Basic para Aplicações janela.
2. Clique inserção > Módulo e cole o código abaixo no script.
VBA: Obter Renomear Imagens
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. Pressione F5 para executar o código e uma caixa de diálogo é exibida para lembrá-lo de selecionar os nomes da imagem original que deseja substituir. Veja a imagem:
4. Clique OKe selecione os novos nomes que deseja substituir os nomes das imagens na segunda caixa de diálogo. Veja a imagem:
5. Clique OK, uma caixa de diálogo aparecerá para lembrá-lo de que os nomes das imagens foram substituídos com sucesso.
6. Clique em OK e os nomes das imagens foram substituídos pelas células na folha.
 |
 |
 |
Artigos relativos:
Melhores ferramentas de produtividade de escritório
Aprimore suas habilidades de Excel com o Kutools para Excel e experimente uma eficiência como nunca antes. Kutools para Excel oferece mais de 300 recursos avançados para aumentar a produtividade e economizar tempo. Clique aqui para obter o recurso que você mais precisa...
Office Tab traz interface com guias para o Office e torna seu trabalho muito mais fácil
- Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
- Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
- Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
