[VBA] Εισαγωγή εικόνας και προσαρμογή της

[jockey17]

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

Θέλω να εισάγω σε φύλλο εργασίας εικόνες (.jpg) αντλώντας την πληροφορία για τη θέση στην οποία βρίσκεται αυτή από το περιεχόμενο ενός κελιού. Για παράδειγμα το κελί Α1 περιέχει την ονομασία του αρχείου με όλη τη διαδρομή.

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

Ευχαριστώ εκ των προτέρων για κάθε βοήθεια.

Φιλικά
Δημήτρης

[Spirosgr]

Καλησπέρα
Με βάση το ζητούμενο, το κελί a1, περιέχει όλη την διαδρομή της εικόνας που θα εισαχθεί.
Δηλαδή:
Διαδρομή φακέλου & όνομα εικόνας & κατάληξη.
Στο κελί b1, έχουμε προσαρμόσει τις διαστάσεις, κατά την κρίση μας και κατά τις ανάγκες της εργασίας μας.
Θέλουμε:
Να εισαχθεί, στο b1, η εικόνα με διαδρομή a1 και
να προσαρμοστεί στις διαστάσεις του κελιού b1.

Σε μια λειτουργική μονάδα αντιγράφουμε τον κώδικα:

Sub InsertPictures()
    Application.ScreenUpdating = False
    Dim myPath As String
    myPath = Sheet2.Range("a1")
    Dim Pic As Picture
    Dim obj As Variant
    Dim Pict As Variant
    'Διαγράφει παλιές εικόνες από το φύλλο
    Set obj = Sheet2.Shapes
    For Each Pict In obj
        If Left(Pict.Name, 7) = "Picture" Then
            Pict.Delete
        End If
    Next Pict
    'Εισαγωγή νέας εικόνας
    Set Pic = Sheet2.Pictures.Insert(myPath)
    'Προσαρμογή στο κελί b1
    With Pic
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = Sheet2.Cells(1, 2).Height
        .Width = Sheet2.Cells(1, 2).Width
        .Top = Sheet2.Cells(1, 2).Top
        .Left = Sheet2.Cells(1, 2).Left
        .Placement = xlMoveAndSize
    End With
    'Άδειασμα και έξοδος
    Set Pic = Nothing
End Sub

*Sheet2. = το κωδικό όνομα του φύλλου
**Αν πρέπει στο φύλλο, να υπάρχουν και αλλού σχήματα ή εικόνες,
να μετονομαστούν σε κάτι που δεν περιέχει Picture χ

[jockey17]

Σε ευχαριστώ πολύ Σπύρο.
Όπως πάντα άψογος. Να είσαι καλά.

Φιλικά
Δημήτρης