Conas gach ainm íomhá a athainmniú i bhfillteán de réir liosta cealla in Excel?
An ndearna tú iarracht riamh íomhánna a athainmniú de réir liosta cealla i mbileog? Má tá, an bhfuil aon chleas agat an post a láimhseáil go tapa gan iad a athainmniú ceann ar cheann? San Airteagal seo, tugaim isteach dhá chód VBA chun an post seo a láimhseáil go tapa in Excel.
Athainmnigh ainmneacha na n-íomhánna go léir i bhfillteán
Athainmnigh ainmneacha na n-íomhánna go léir i bhfillteán
Chun ainmneacha na n-íomhánna go léir a athainmniú i bhfillteán sonraithe, ní mór duit na hainmneacha bunaidh a liostáil ar an mbileog ar dtús.
1. Brúigh Alt + F11 eochracha chun an Microsoft Visual Basic d’Fheidhmchláir fhuinneog.
2. cliceáil Ionsáigh > Modúil agus greamaigh thíos an cód leis an script.
VBA: Faigh ainmneacha pictiúr de fhillteá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. Brúigh F5 eochair chun an cód a rith, agus tagann dialóg amach le cur i gcuimhne duit cill a roghnú chun an liosta ainmneacha a aschur. Féach an pictiúr:
4. cliceáil OK agus an fillteán sonraithe a roghnú a gcaithfidh tú a liostú sa bhileog oibre reatha. Féach an pictiúr:
5. cliceáil OK. Tá ainmneacha na bpictiúr liostaithe ar an mbileog ghníomhach.
Ansin is féidir leat na pictiúir a athainmniú.
1. Brúigh Alt + F11 eochracha chun an Microsoft Visual Basic d’Fheidhmchláir fhuinneog.
2. cliceáil Ionsáigh > Modúil agus greamaigh thíos an cód leis an script.
VBA: Faigh Athainmnigh Pictiúir
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 Sub
3. Brúigh F5 eochair chun an cód a rith, agus tagann dialóg amach le cur i gcuimhne duit na hainmneacha pictiúr bunaidh a theastaíonn uait a athsholáthar a roghnú. Féach an pictiúr:
4. cliceáil OK, agus roghnaigh na hainmneacha nua a theastaíonn uait ainmneacha pictiúr a athsholáthar laistigh den dara dialóg. Féach an pictiúr:
5. cliceáil OK, tagann dialóg amach le cur i gcuimhne duit gur athraíodh ainmneacha na bpictiúr go rathúil.
6. Cliceáil OK agus tá na cealla sa bhileog curtha in ionad ainmneacha na bpictiúr.
Ailt Choibhneasta:
Uirlisí Táirgiúlachta Oifige is Fearr
Supercharge Do Scileanna Excel le Kutools le haghaidh Excel, agus Éifeachtúlacht Taithí Cosúil Ná Roimhe. Kutools le haghaidh Excel Tairiscintí Níos mó ná 300 Ardghnéithe chun Táirgiúlacht a Treisiú agus Sábháil Am. Cliceáil anseo chun an ghné is mó a theastaíonn uait a fháil ...
Tugann Tab Oifige comhéadan Tabbed chuig Office, agus Déan Do Obair i bhfad Níos Éasca
- Cumasaigh eagarthóireacht agus léamh tabbed i Word, Excel, PowerPoint, Foilsitheoir, Rochtain, Visio agus Tionscadal.
- Oscail agus cruthaigh cáipéisí iolracha i gcluaisíní nua den fhuinneog chéanna, seachas i bhfuinneoga nua.
- Méadaíonn do tháirgiúlacht 50%, agus laghdaíonn sé na céadta cad a tharlaíonn nuair luch duit gach lá!