Μετάβαση στο κύριο περιεχόμενο

Πώς να εξαγάγετε όλες τις εικόνες ταυτόχρονα από το Excel;

Αν υποθέσουμε ότι έχετε πολλές εικόνες στο βιβλίο εργασίας σας και θέλετε να τις αποθηκεύσετε σε έναν συγκεκριμένο φάκελο κάθε φορά, συνήθως, μπορείτε να αντιγράψετε και να επικολλήσετε τις εικόνες μία προς μία χειροκίνητα για αποθήκευση, αλλά είναι χρονοβόρο να τις αντιγράψετε και να τις επικολλήσετε επανειλημμένα έτσι. Εδώ, θα σας παρουσιάσω μερικές συμβουλές για να λύσετε αυτή τη δουλειά.


Εξαγάγετε όλες τις εικόνες ταυτόχρονα από το Excel με τη λειτουργία Save As

Με το ενσωματωμένο Excel Αποθήκευση ως λειτουργία, μπορείτε να αποθηκεύσετε ένα βιβλίο εργασίας ως ιστοσελίδα για να αποθηκεύσετε όλες τις εικόνες, συμπεριλαμβανομένων γραφημάτων, σχημάτων και άλλων αντικειμένων σε ένα φάκελο. Κάντε τα εξής.

1. Ανοίξτε το βιβλίο εργασίας με τις εικόνες που θέλετε να αποθηκεύσετε. Κάντε κλικ Αρχεία > Αποθήκευση ως > Ξεφυλλίζω.

2. Στο Αποθήκευση ως πλαίσιο διαλόγου, πρέπει:

2.1) Επιλέξτε ένα φάκελο για να αποθηκεύσετε τις εξαγόμενες εικόνες.
2.2) Επιλέξτε ιστοσελίδα από την αναπτυσσόμενη λίστα Αποθήκευση ως τύπου.
2.3) Κάντε κλικ στο Αποθήκευση κουμπί.

3. Στο αναδυόμενο παράθυρο Microsoft Excel , κάντε κλικ στο Ναι κουμπί.

4. Ανοίξτε το φάκελο όπου αποθηκεύονται τα εξαγόμενα αρχεία και μπορείτε να δείτε έναν φάκελο και ένα αρχείο μορφής HTML που παρατίθενται μέσα. Όλες οι εικόνες στο βιβλίο εργασίας, συμπεριλαμβανομένων γραφημάτων, σχημάτων ή αντικειμένων αποθηκεύονται σε αυτόν τον φάκελο.

5. Μπορείτε να κρατήσετε τις φωτογραφίες που χρειάζεστε στο φάκελο και να διαγράψετε άλλες που δεν χρειάζεστε


Εξάγετε εύκολα όλες τις εικόνες ταυτόχρονα από το Excel με ένα εκπληκτικό εργαλείο

Η παραπάνω μέθοδος θα εξαγάγει όλα τα αντικείμενα από το βιβλίο εργασίας, ίσως κάποια από αυτά δεν χρειάζεστε. Εάν έχετε Kutools για Excel εγκατεστημένο στο Excel, του Εξαγωγή γραφικών η δυνατότητα μπορεί να σας βοηθήσει να αποθηκεύσετε μόνο τις φωτογραφίες που χρειάζεστε.

Μετά την εγκατάσταση Kutools για Excel, κάντε τα εξής:

1. κλικ Kutools Plus > Εισαγωγή εξαγωγή > Εξαγωγή γραφικών:

2. Στο Εξαγωγή γραφικών πλαίσιο διαλόγου, διαμορφώστε τα εξής:

2.1) Επιλέξτε Εικόνες από το Τύποι αναπτυσσόμενη λίστα
Συμβουλές: Από προεπιλογή, παρατίθενται όλα τα γραφικά, συμπεριλαμβανομένων των γραφημάτων, των εικόνων και των σχημάτων στο τρέχον βιβλίο εργασίας.
2.2) Στο Αποθήκευση καταλόγου κάντε κλικ στο κουμπί για να επιλέξετε έναν φάκελο για να αποθηκεύσετε τις εξαγόμενες φωτογραφίες σας.
2.3) Στο Εξαγωγή μορφής αναπτυσσόμενη λίστα, επιλέξτε τον τύπο της εικόνας που θέλετε να εξαγάγετε ως
2.4) Κάντε κλικ στο κουμπί Εντάξει.

3. Στη συνέχεια, εμφανίζεται ένα παράθυρο διαλόγου για να σας πει πόσες εικόνες έχουν εξαχθεί με επιτυχία, κάντε κλικ στο OK κουμπί.

Τώρα μπορείτε να μεταβείτε στον φάκελο προορισμού και να ελέγξετε τις εξαγόμενες εικόνες.

Παρακαλώ κάντε κλικ Εξαγωγή γραφικών για να μάθετε περισσότερα σχετικά με αυτήν τη δυνατότητα.

Πριν από την εφαρμογή Kutools για Excel, σας παρακαλούμε κατεβάστε και εγκαταστήστε το πρώτα.


Εξαγωγή εικόνων και μετονομασία τους με τις τιμές των παρακείμενων κελιών

Όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης, υπάρχουν δύο στήλες, η μία περιέχει μια λίστα με ονόματα φρούτων και η άλλη περιέχει τις αντίστοιχες εικόνες των φρούτων. Για να εξαγάγετε αυτές τις εικόνες και να τις ονομάσετε αυτόματα με τα αντίστοιχα ονόματα φρούτων, μπορείτε να δοκιμάσετε τον κωδικό VBA σε αυτήν την ενότητα.

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

2. Στο Microsoft Visual Basic για εφαρμογές παράθυρο, κάντε κλικ στην επιλογή Κύριο θέμα > Μονάδα μέτρησης. Στη συνέχεια, αντιγράψτε το ακόλουθο VBA στο παράθυρο Module.

Κωδικός VBA: Εξαγωγή εικόνων σε μια στήλη και ονομασία τους αυτόματα

Sub ExportImages_ExtendOffice()
'Updated by Extendoffice 20220308
    Dim xStrPath As String
    Dim xStrImgName As String
    Dim xImg As Shape
    Dim xObjChar As ChartObject
    Dim xFD As FileDialog
    Set xFD = Application.FileDialog(msoFileDialogFolderPicker)
    xFD.Title = "Please select a folder to save the pictures" & " - ExtendOffice"
    If xFD.Show = -1 Then
       xStrPath = xFD.SelectedItems.Item(1) & "\"
    Else
        Exit Sub
    End If
    
    On Error Resume Next
    For Each xImg In ActiveSheet.Shapes
        If xImg.TopLeftCell.Column = 2 Then
        xStrImgName = xImg.TopLeftCell.Offset(0, -1).Value
        If xStrImgName <> "" Then
            xImg.Select
            
            Selection.Copy
            Set xObjChar = ActiveSheet.ChartObjects.Add(0, 0, xImg.Width, xImg.Height)
            With xObjChar
                .Border.LineStyle = xlLineStyleNone
                .Activate
                ActiveChart.Paste
                .Chart.Export xStrPath & xStrImgName & ".png"
                .Delete
            End With
        End If
        End If
    Next
End Sub

:

1) Ο αριθμός 2 στη γραμμή "Αν xImg.TopLeftCell.Column = 2 Τότε” αντιπροσωπεύει τον αριθμό της στήλης από την οποία θέλετε να εξαγάγετε τις εικόνες.
2) Ο αριθμός -1 στη γραμμή "xStrImgName = xImg.TopLeftCell.Offset(0, -1).ΤιμήΤο δηλώνει ότι θα ονομάσετε τις εικόνες με τις τιμές των διπλανών αριστερών κελιών.

3. Πάτα το F5 κλειδί για την εκτέλεση του κώδικα. Στο παράθυρο που ανοίγει, επιλέξτε έναν φάκελο για να αποθηκεύσετε τις εικόνες και μετά κάντε κλικ Εντάξει.

Στη συνέχεια, όλες οι εικόνες σε μια καθορισμένη στήλη εξάγονται και ονομάζονται αυτόματα με τις τιμές των παρακείμενων κελιών όπως καθορίσατε.


Σχετικό άρθρο:

Πώς να εξαγάγετε γραφήματα σε γραφικά στο Excel;

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

🤖 Kutools AI Aide: Επανάσταση στην ανάλυση δεδομένων με βάση: Ευφυής Εκτέλεση   |  Δημιουργία κώδικα  |  Δημιουργία προσαρμοσμένων τύπων  |  Αναλύστε δεδομένα και δημιουργήστε γραφήματα  |  Επίκληση Λειτουργιών Kutools...
Δημοφιλή χαρακτηριστικά: Εύρεση, επισήμανση ή αναγνώριση διπλότυπων   |  Διαγραφή κενών γραμμών   |  Συνδυάστε στήλες ή κελιά χωρίς απώλεια δεδομένων   |   Γύρος χωρίς φόρμουλα ...
Σούπερ Αναζήτηση: VLookup πολλαπλών κριτηρίων    VLookup πολλαπλών τιμών  |   VLookup σε πολλά φύλλα   |   Ασαφής αναζήτηση ....
Σύνθετη αναπτυσσόμενη λίστα: Γρήγορη δημιουργία αναπτυσσόμενης λίστας   |  Εξαρτημένη αναπτυσσόμενη λίστα   |  Πολλαπλή αναπτυσσόμενη λίστα ....
Διαχειριστής στήλης: Προσθέστε έναν συγκεκριμένο αριθμό στηλών  |  Μετακίνηση στηλών  |  Εναλλαγή κατάστασης ορατότητας κρυφών στηλών  |  Συγκρίνετε εύρη και στήλες ...
Επιλεγμένα Χαρακτηριστικά: Εστίαση πλέγματος   |  Προβολή σχεδίου   |   Μεγάλη Formula Bar    Διαχείριση βιβλίου εργασίας & φύλλου   |  Βιβλιοθήκη πόρων (Αυτόματο κείμενο)   |  Επιλογή ημερομηνίας   |  Συνδυάστε φύλλα εργασίας   |  Κρυπτογράφηση/Αποκρυπτογράφηση κελιών    Αποστολή email ανά λίστα   |  Σούπερ φίλτρο   |   Ειδικό φίλτρο (φίλτρο με έντονη γραφή/πλάγια γραφή/διαγραφή...) ...
Κορυφαία 15 σύνολα εργαλείων12 Κείμενο Εργαλεία (Προσθήκη κειμένου, Κατάργηση χαρακτήρων, ...)   |   50 + Διάγραμμα Τύποι (Gantt διάγραμμα, ...)   |   40+ Πρακτικό ΜΑΘΗΜΑΤΙΚΟΙ τυποι (Υπολογίστε την ηλικία με βάση τα γενέθλια, ...)   |   19 Εισαγωγή Εργαλεία (Εισαγωγή κωδικού QR, Εισαγωγή εικόνας από το μονοπάτι, ...)   |   12 Μετατροπή Εργαλεία (Αριθμοί σε λέξεις, Μετατροπή Συναλλάγματος, ...)   |   7 Συγχώνευση & διαχωρισμός Εργαλεία (Σύνθετες σειρές συνδυασμού, Διαίρεση κελιών, ...)   |   ... κι αλλα

Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου.  Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...

Περιγραφή


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

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
Comments (24)
Rated 5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
WaW Amazing ! Thanks a lot ! It works perfect for me !
I couldn't insert Milan's code inside the first one, so maybe you could update with the two codes combined ?
It is because my pictures are so small...
Rated 5 out of 5
This comment was minimized by the moderator on the site
Thank you! The code does the job. The only downside is it exports images in displayed size, not in original size. And it's often the case, when an otherwise large image is scaled down to fit in the cell. Is there a way to tweak this code to export original size images?

Sub ExportImages_ExtendOffice()
'Updated by Extendoffice 20220308
    Dim xStrPath As String
    Dim xStrImgName As String
    Dim xImg As Shape
    Dim xObjChar As ChartObject
    Dim xFD As FileDialog
    Set xFD = Application.FileDialog(msoFileDialogFolderPicker)
    xFD.Title = "Please select a folder to save the pictures" & " - ExtendOffice"
    If xFD.Show = -1 Then
       xStrPath = xFD.SelectedItems.Item(1) & "\"
    Else
        Exit Sub
    End If
    
    On Error Resume Next
    For Each xImg In ActiveSheet.Shapes
        If xImg.TopLeftCell.Column = 2 Then
        xStrImgName = xImg.TopLeftCell.Offset(0, -1).Value
        If xStrImgName <> "" Then
            xImg.Select
            
            Selection.Copy
            Set xObjChar = ActiveSheet.ChartObjects.Add(0, 0, xImg.Width, xImg.Height)
            With xObjChar
                .Border.LineStyle = xlLineStyleNone
                .Activate
                ActiveChart.Paste
                .Chart.Export xStrPath & xStrImgName & ".png"
                .Delete
            End With
        End If
        End If
    Next
End Sub
This comment was minimized by the moderator on the site
same issue...
just a quick edit:
If xStrImgName <> "" Then
            xImg.Select
          [b]  xImg.ScaleHeight 1#, True, msoScaleFromTopLeft
            xImg.ScaleWidth 1#, True, msoScaleFromTopLeft[/b]


this will resize all images, so you have to close the file afterwards without saving to preserve the initial vie, but the pictures will go out in their original size.
This comment was minimized by the moderator on the site
fixed, thank you anyway:

Sub ExportImages_ExtendOffice()
'Updated by Extendoffice 20220308
    Dim xStrPath As String
    Dim xStrImgName As String
    Dim xImg As Shape
    Dim xObjChar As ChartObject
    Dim xFD As FileDialog
    Set xFD = Application.FileDialog(msoFileDialogFolderPicker)
    xFD.Title = "Please select a folder to save the pictures" & " - ExtendOffice"
    If xFD.Show = -1 Then
       xStrPath = xFD.SelectedItems.Item(1) & "\"
    Else
        Exit Sub
    End If
    
    On Error Resume Next
    For Each xImg In ActiveSheet.Shapes
        If xImg.TopLeftCell.Column = 2 Then
        xStrImgName = xImg.TopLeftCell.Offset(0, -1).Value
        If xStrImgName <> "" Then
            xImg.Select
'            Selection.Copy
            Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            Set xObjChar = ActiveSheet.ChartObjects.Add(0, 0, xImg.Width, xImg.Height)
            With xObjChar
                .Parent.ShapeRange.Line.Visible = msoFalse
                .Border.LineStyle = xlLineStyleNone
'                .Activate
                .Select
                ActiveChart.Paste
                .Chart.Export xStrPath & xStrImgName & ".png"
                .Delete
            End With
        End If
        End If
    Next
End Sub
This comment was minimized by the moderator on the site
Thank you for this great tool, It saved me a ton of time. But I've ran into an issue that most of the photos are saved as blank photos as shown in the attached screenshot. Appreciate the help. Thank you
This comment was minimized by the moderator on the site
Hello, Mohamed
Did your problem occur when using Kutools for Excel? If so, could you upload your workbook file here if you don't mind?
So that, we can check where the problem is?
Thank you!
This comment was minimized by the moderator on the site
I am using the code given in the " Export images and rename them with the adjacent cell values" part of the article. When I run this code I get the following error: "Run-time error '91': Object variable or With block variable not set."

When I click "debug" it points me to line 9 of the code :
xFD.Title = "Please select a folder to save the pictures" & " - ExtendOffice"

Do you have a solution to this? Your article is the only solution I can find.

I am using Excel for Mac.
This comment was minimized by the moderator on the site
Hello, Dylan,

Sorry, our code is only applicable to Microsoft Excel, maybe you can try the code in Microsoft Excel.
Thank you!
This comment was minimized by the moderator on the site
I am using Microsoft Excel on Mac OSX.
This comment was minimized by the moderator on the site
I am also getting this issue using a Mac - Dylan were you able to resolve?

Are we meant to change something with the below that it is picking up as a bug?

xFD.Title = "Please select a folder to save the pictures" & " - ExtendOffice"
This comment was minimized by the moderator on the site
Hello, thank you for this article. When I execute the code above from Export images and rename them with the adjacent cell values, I get the following error message: Run-time error '91': Object variable or With block variable not set. When I click debug, it highlights line 9 of the code. Do you know why this is happening? FYI I am using Excel for Mac OSX. Thank you
This comment was minimized by the moderator on the site
Τέλειο εργαλείο! Όμως το μέγεθος-ανάλυση της εικόνας μικραίνει . Υπάρχει τρόπος να διατηρηθεί η αρχική ανάλυση ?
This comment was minimized by the moderator on the site
Bonjour le code VBA m'enregistre des images blanches je ne comprends pas pourquoi. quelqu'un a une solution ?
This comment was minimized by the moderator on the site
Hello, Sophie,
The code in this article can work well in my Excel, could you upload your Excel file here if you don't mind? So we can help to check the problem for you.
Or you can describe your problem more clear and detailed.
Thank you!
This comment was minimized by the moderator on the site
hallo skyyang, ich habe seit neulich das gleiche problem, viele leere *.png dateien.
Your text to link
bei jedem exportversuch werden andere bilder nicht richtig erfasst.
mfg und danke
This comment was minimized by the moderator on the site
Hello, milan bojic
Which Excel version do you use?
I have tried the code in your workbook, it works well, and all the images in your workbook are exported in the folder and renamed based on the cell value, see screenshot:
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-export-images-1.png
This comment was minimized by the moderator on the site
Hello skyyang, it's office 365. your code was working fine until 2 weeks ago, not anymore, see screenshot. meanwhile i found something similar that works, (combined with yours), maybe you can use that for your code.

screenshot:
[img]https://drive.google.com/file/d/1vfRlhpyzqg7QNFeYl53mTvNON3gIrFwv/view?usp=sharing[/img]


Sub BilderExportieren()
    Dim shaBild As Shape
    Dim strZielpfad As String
    strZielpfad = "c:\Tuerliste\img3\" '<== Zielpfad entsprechend anpassen!!
    For Each shaBild In ActiveSheet.Shapes
        BildExportShape shaBild, strZielpfad
    Next shaBild
End Sub

Sub BildExportShape(shaBild As Shape, strZiel As String)
    Dim xStrImgName As String
    Dim chDiagramm As ChartObject
    xStrImgName = shaBild.TopLeftCell.Offset(0, -1).Value
    Application.ScreenUpdating = False
    shaBild.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set chDiagramm = ActiveSheet.ChartObjects.Add(0, 0, shaBild.Width, shaBild.Height)
    With chDiagramm.Chart
        ' erforderlich bei Excel2010, da Diagrammfläche automatisch mit Rahmen erstellt wird
        .Parent.ShapeRange.Line.Visible = msoFalse
        ' bei Excel2016 muss die Diagrammfläche selektiert vor .Paste werden - andernfalls ist das Bild leer
        If Val(Application.Version) = 16 Then .ChartArea.Select
        .Paste
        .Export Filename:=strZiel & xStrImgName & ".png", FilterName:="png"
    End With
    chDiagramm.Delete
    Set chDiagramm = Nothing
    Set shaBild = Nothing
    Application.ScreenUpdating = True
End Sub


Thank you anyway
Milan Bojic
This comment was minimized by the moderator on the site
Hello, milan bojic,
Thanks for your code, maybe it can help others in the future. 🙂
This comment was minimized by the moderator on the site
This is great, if I wanted to grab the background colour of a cell (instead of an image) and save that as a image named with the adjacent cell how would that be an easy change to the code?
This comment was minimized by the moderator on the site
Hi Tom,Do you mean saving the background color of the cell as an image and named it with the adjacent cell value?Sorry can't help you with that.
This comment was minimized by the moderator on the site
thanks a lot it helped me a lot
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations