Afbeelding of foto laden

[Neuz]

Hey allemaal,

Ik ben bezig om een afbeelding of foto te laten laden op een worksheet.
Wat ik precies wil is dat er gekeken wordt of de foto in de map op mijn
computer bestaat, als dit zo is dan moet deze foto worden weergegeven.
Zo niet dan moet de afbeelding, welke op het tabblad in excel staat, worden
geladen.

Tot dus ver geen bijzonderheden dit gaat namelijk goed.

Wat mij echter nog niet lukt is voordat er een nieuwe afbeelding/foto geladen
wordt om de oude weg te halen.

Ook het opmaken van de grote van zowel de afbeelding als de foto lukt nog niet.

Zouden jullie me met dit probleem kunnen helpen?

Dit is de huidige code:

Sub Foto()
    With Worksheets("Blad1")
        URL = .Range("B2").Value & .Range("B3").Value & .Range("B4").Value
        .Shapes.Range(Array("Afbeelding 1")).Visible = msoFalse
        
        If Dir(URL) = "" Then
            With .Shapes("Afbeelding 1")
                .Visible = msoTrue
                .Top = Range("B8").Top
                .Left = Range("B8").Left
                .Width = (.Width / .Height)
                .Height = Range("G4").Height
            End With
        Else
            .Range("B8").Select
            ActiveSheet.Pictures.Insert(URL).Select
        End If
    End With
End Sub

Deze staat in het voorbeeld bestand:
Bekijk bijlage Foto laden.xlsm

Alvast bedankt.

Groet Neuz

 

[wampier]

Hoe bedoel je: "oude weghalen" echt verwijderen of weer onzichtbaar maken? Ook lijkt me handig om eerst de juiste hoogte in te stellen en dan pas de breedte. De volgorde in bovenstaande code komt me nogal vreemd over.

 

[Neuz]

Beste Wampier,

De oude foto (die uit de lokale map komt) mag verwijderd worden van de werkmap niet uit de lokale map.
De afbeelding (welke standaard op het werkblad staat) moet alleen onzichtbaar worden.

Het stukje tussen de With heb ik van internet zou dus niet weten hoe dit werkt.

With 
   .Shapes("Afbeelding 1")
   .Visible = msoTrue
   .Top = Range("B8").Top
   .Left = Range("B8").Left
   .Width = (.Width / .Height)
   .Height = Range("G4").Height
End With

Hopelijk is mijn uitleg zo iets makkelijker te begrijpen.

Alvast bedankt voor je hulp.

Groet Neuz

 

[wampier]

Maar wat gaat er dan fout? (met de grootte)

Ik krijg mooi een duimpje en die past in de gele regel. vervolgens met een goed plaatje wordt het duimpje onzichtbaar en komt het plaatje tevoorschijn.

wat moet er nu anders gebeuren?

 

[Neuz]

Beste Wampier,

De beide plaatjes komen ook inderdaad tevoorschijn. Het plaatje gaat echter niet weg.
Beter gezegd de plaatjes worden over elkaar heen gezet.

Op het moment dat ik een foto kies die niet bestaat krijg ik het duimpje.
Als ik direct daarna een foto kies die wel bestaat krijg ik die foto.
Als ik hierna weer een foto kies die niet bestaat wordt hij duimpje niet mee getoond.

Ook worden beide afbeeldingen niet op dezelfde grote weergegeven. In de situatie zoals ik
deze nodig heb moet de afbeelding de volgende formaten krijgen door middel van een macro.
Hoogte: 6.37 cm
Breedte: 4.72 cm
De linkerbovenhoek van de afbeelding moet komen in de cel B7.

Misschien ligt het aan mijn versie van office. Ik maak gebruik van office 2007.

Ik ben nieuwsgierig.

Alvast weer bedankt voor de moeite.

Groet Neuz

 

[wampier]

Grootte in cm instellen is niet echt goed mogelijk, omdat de conversie beeldpunten naar cm nogal ingewikkeld is. Je moet dat een beetje handmatig doen door te spelen met de parameters "width" en "height". Met onderstaande code wordt het handje weer zichtbaar na selecteren niet bestaande foto.

Sub Foto()
    With Worksheets("Blad1")
        URL = .Range("B2").Value & .Range("B3").Value & .Range("B4").Value
        .Shapes.Range(Array("Afbeelding 1")).Visible = msoFalse
        
        If Dir(URL) = "" Then
            For Each shap In ActiveSheet.Pictures
                If shap.Name <> "Afbeelding 1" Then
                    shap.Delete
                End If
            Next shap
            With .Shapes("Afbeelding 1")
                .Visible = msoTrue
                .Top = Range("B8").Top
                .Left = Range("B8").Left
                .Width = (.Width / .Height)
                .Height = Range("G4").Height
            End With
        Else
            Set mijnAfb = ActiveSheet.Pictures.Insert(URL)
            With mijnAfb
                .Top = [b8].Top
                .Left = [b8].Left
                .Width = 60
                .Height = 40
            End With
        End If
    End With
End Sub

 

[Warme bakkertje]

Waarom geen Image-Control op het werkblad ?
1-malig instellen op de juiste grootte, de SizeMode op Stretch en de foto's worden steeds correct weergegeven.

 

[Neuz]

Hallo Warme bakkertje,

Werkt de oplossing die jij geeft ook met afbeeldingen die reeds op je werkblad staan?

Groet Neuz

 

[Warme bakkertje]

Neen, enkel figuurbestanden kunnen geladen worden in een Image-Control.
Wat betreft de omzetting, er gaan 28,35 Points in 1 cm dus 6,37 cm = 180,5 Points en 4,72 cm = 134,8 Points.

 

[Neuz]

Beste Wampier en Warm bakkertje,

Sorry van de late reactie. Ik heb de optie van Wampier gebruikt en werkt super.
Morgen maar even kijken hoe ik de grote moet aanpassen maar dat gaat me wel
lukken.

Bedankt voor de hulp en het slotje gaat op deze vraag.

Voor de overige gebruikers de oplossing voor mij was:

Sub Foto()
    With Worksheets("Blad1")
        URL = .Range("B2").Value & .Range("B3").Value & .Range("B4").Value
        .Shapes.Range(Array("Afbeelding 1")).Visible = msoFalse
        
        If Dir(URL) = "" Then
            For Each shap In ActiveSheet.Pictures
                If shap.Name <> "Afbeelding 1" Then
                    shap.Delete
                End If
            Next shap
            With .Shapes("Afbeelding 1")
                .Visible = msoTrue
                .Top = Range("B8").Top
                .Left = Range("B8").Left
                .Width = (.Width / .Height)
                .Height = Range("G4").Height
            End With
        Else
            Set mijnAfb = ActiveSheet.Pictures.Insert(URL)
            With mijnAfb
                .Top = [b8].Top
                .Left = [b8].Left
                .Width = 60
                .Height = 40
            End With
        End If
    End With
End Sub