Note: The other languages of the website are Google-translated. Back to English

Πώς να μετονομάσετε όλα τα ονόματα εικόνων σε ένα φάκελο σύμφωνα με μια λίστα κελιών στο 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, ".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. Τύπος 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% και μειώνει εκατοντάδες κλικ ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Σχόλια (4)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια, προσπάθησα να το χρησιμοποιήσω, ωστόσο η εκτέλεση της μακροεντολής 'PictureNametoExcel' επιστρέφει μόνο το όνομα της διαδρομής του πρώτου αρχείου φωτογραφίας. Οι υπόλοιπες φωτογραφίες του φακέλου δεν θα εμφανίζονται στη λίστα. Οποιαδήποτε βοήθεια θα εκτιμηθεί ιδιαίτερα.

Πλευρική σημείωση: Έχω δοκιμάσει τη μακροεντολή "RenameFile" και λειτουργεί τέλεια

Ευχαριστώ
Sam
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Sam, Επιλέξτε την περιοχή κελιών. Υποθέτω ότι αυτό οφείλεται στο ότι επιλέξατε μόνο ένα κελί
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Hi, It renames only the first 10 pics of the folder, could you please help me out with the changes for 100 pics. Thanks & Regards
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Hi, edvin.I G Lazar, I have tested the code, it can rename all pictures you list, if it only rename first 10 of the folder, please check what is the picture type, the suffix, in the first code, it just supports to list the pictures(".jpg" ".png" ".img" ".gif" ".ioc" ".bmp"), if your picture is not in the types the code list you can manually add it to the code, like+ InStr(1, xFileName, ".png")
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες