foto invoegen met macro

[W Bloemendal]

Ik heb het volgende in een macro

 ActiveSheet.Pictures.Insert( _
        "D:\mijn documenten\Mijn afbeeldingen\buitenlust03b.jpg").Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 188.25
    Selection.ShapeRange.Width = 262.5
    Selection.ShapeRange.Rotation = 0#

Nu wordt er een bepaalde foto door de macro ingevoegd maar is het ook mogelijk dat als de macro gestart is, dat ik dan naar een foto kan zoeken die ik daar wil hebben.

wim

 

[Roncancio]

Hallo,

Jazeker. Met behulp van GetOpenFilename.

Sub Invoegen()

FileToOpen = Application.GetOpenFilename _
(Title:="Kies een afbeelding om in het bestand te zetten.", FileFilter:="*.jpg (*.jpg),")
If FileToOpen = False Then
    MsgBox "Geen afbeelding geselecteerd.", vbExclamation, "Geen afbeelding geselecteerd.!"
    Exit Sub
Else
    ActiveSheet.Pictures.Insert(FileToOpen).Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 188.25
    Selection.ShapeRange.Width = 262.5
    Selection.ShapeRange.Rotation = 0#
    
End If
End Sub

Met vriendelijke groet,


Roncancio

 

[W Bloemendal]

Nu heb ik hier op nog een vraag als ik een afbeelding toegevoegd heb dan wordt de afbeelding met bij behorende cellen gecopieerd naar een ander blad en het invoer gedeelte leeg gemaakt met

Range("A1:K11").Select
Selection.ClearContents

Maar de afbeelding heb ik in D1 ingevoerd maar deze gaat dan niet weg.
heb geprobeerd om hiervoor een macro temaken maar de afbeelding heeft steeds een andere naam. bv dit

ActiveSheet.Shapes("Picture 8").Select
Selection.Cut

dus dit kan ik niet in de macro zetten maar wat dan wel.

wim

 

[huijb]

Beste W Bloemendal, Heb ik u er al niet eens opgewezen dat codes tussen de codetags(#) moet worden geplaatst. Volgens mij wel, maar heb desondanks gisteren en vandaag toch weer berichten moeten aanpassen. Ik zou u daarom willen verzoeken om dit in de toekomst toch te gaan doen.

 

[Finch]

Je kan doorheen al je shapes te loopen en via de topleftcell eigenschap kan je dan ziet of hij in het gebied valt waar je iets wil verwijderen, dan kan je dat via een IF THEN ELSE structuur oplossen.

Wat voorbeeldcode dat aangeeft in het direct venster wat de adressen van die topleftcell zijn.

Sub test()
Dim shp As Shape

For Each shp In ActiveSheet.Shapes
    Debug.Print shp.TopLeftCell.Address
Next shp
End Sub

Andere mogelijkheden bij het invoegen van die afbeelding geef je die shape ook een naam die je onder controle hebt, dan weet je misschien ook welke figuren je moet verwijderen.