Note: The other languages of the website are Google-translated. Back to English
Σύνδεση  \/ 
x
or
x
Εγγραφή  \/ 
x

or

Πώς να μετονομάσετε όλα τα ονόματα εικόνων σε ένα φάκελο σύμφωνα με μια λίστα κελιών στο Excel;

Έχετε προσπαθήσει ποτέ να μετονομάσετε εικόνες σύμφωνα με μια λίστα κελιών στο φύλλο; Εάν ναι, έχετε κάποια κόλπα για να χειριστείτε γρήγορα τη δουλειά χωρίς να τις μετονομάσετε ένα προς ένα; Σε αυτό το άρθρο, εισάγω δύο κωδικούς VBA για γρήγορο χειρισμό αυτής της εργασίας στο Excel.

Μετονομάστε όλα τα ονόματα εικόνων σε ένα φάκελο


Μετονομάστε όλα τα ονόματα εικόνων σε ένα φάκελο

Για να μετονομάσετε όλα τα ονόματα εικόνων σε έναν καθορισμένο φάκελο, πρέπει πρώτα να αναφέρετε τα αρχικά ονόματα στο φύλλο.

1. Τύπος Alt + F11 πλήκτρα για να ενεργοποιήσετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

2. κλικ Κύριο θέμα > Μονάδα μέτρησης και επικολλήστε τον παρακάτω κώδικα στο σενάριο.

VBA: Λήψη ονομάτων εικόνων ενός φακέλου

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, ".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. Τύπος F5 για να εκτελέσετε τον κώδικα και εμφανίζεται ένα παράθυρο διαλόγου για να σας υπενθυμίσει να επιλέξετε ένα κελί για να εμφανιστεί η λίστα ονομάτων. Δείτε το στιγμιότυπο οθόνης:
doc μετονομασία εικόνας σε ένα φάκελο 1

4. κλικ OK και για να επιλέξετε τον καθορισμένο φάκελο του οποίου τα ονόματα εικόνων πρέπει να αναφέρετε στο τρέχον φύλλο εργασίας. Δείτε το στιγμιότυπο οθόνης:
doc μετονομασία εικόνας σε ένα φάκελο 2

5. κλικ OK. Τα ονόματα των εικόνων έχουν αναφερθεί στο ενεργό φύλλο.

Στη συνέχεια, μπορείτε να μετονομάσετε τις εικόνες.

1. Τύπος Alt + F11 πλήκτρα για να ενεργοποιήσετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

2. κλικ Κύριο θέμα > Μονάδα μέτρησης και επικολλήστε τον παρακάτω κώδικα στο σενάριο.

VBA: Λήψη μετονομασίας εικόνων

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. Τύπος F5 για να εκτελέσετε τον κώδικα και εμφανίζεται ένα παράθυρο διαλόγου που σας υπενθυμίζει να επιλέξετε τα αρχικά ονόματα εικόνων που θέλετε να αντικαταστήσετε. Δείτε το στιγμιότυπο οθόνης:
doc μετονομασία εικόνας σε ένα φάκελο 3

4. κλικ OKκαι επιλέξτε τα νέα ονόματα που θέλετε να αντικαταστήσετε τα ονόματα εικόνων στο δεύτερο διάλογο. Δείτε το στιγμιότυπο οθόνης:
doc μετονομασία εικόνας σε ένα φάκελο 4

5. κλικ OK, εμφανίζεται ένας διάλογος για να σας υπενθυμίσει ότι τα ονόματα των εικόνων έχουν αντικατασταθεί με επιτυχία.
doc μετονομασία εικόνας σε ένα φάκελο 5

6. Κάντε κλικ στο OK και τα ονόματα των εικόνων έχουν αντικατασταθεί από τα κελιά του φύλλου.

doc μετονομασία εικόνας σε ένα φάκελο 6
βέλος εγγράφου προς τα κάτω
doc μετονομασία εικόνας σε ένα φάκελο 7

Σχετικά άρθρα:


Τα καλύτερα εργαλεία παραγωγικότητας του Office

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2019 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Sam Jones · 2 years ago
    Hi, i've tried using this however running the 'PictureNametoExcel' macro only returns the first photo file path name. The other photos in the folder wont be listed. Any help would be greatly appreciated.

    Side note: I've tested the 'RenameFile' Macro and that works perfectly

    Thanks
    Sam
    • To post as a guest, your comment is unpublished.
      Dunmoye · 11 months ago
      Hi Sam, Select the cell range. I guess this is as a result of you selecting just one cell