• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Foto in cel plaatsen via knop

Status
Niet open voor verdere reacties.

danny147

Terugkerende gebruiker
Lid geworden
29 apr 2007
Berichten
4.744
Beste,

Via Vert.Zoeken vind ik Hyperlinks die aan een cel worden gekoppeld (F10)
Via een knop kan ik deze ophalen met volgende code:

Code:
Sub zoeken3()
Application.ScreenUpdating = False
On Error GoTo Einde
ActiveWorkbook.FollowHyperlink _
Address:=Sheets("Gereedschappenlijst").Range("F10")
Einde:
Exit Sub
Application.ScreenUpdating = True
End Sub

Nu zou ik graag willen dat deze foto in een cel komt te staan, nl. F14
Met een breedte van 15cm en automatische hoogte
 
Foto's kun je niet in een cel zetten, dat zijn losse objecten. Je kunt ze hooguit positioneren tegen een cel aan.
 
Beste OctaFish,

Als ik nu via ontwikkelaars, invoegen, ActiveX-besturingselementen een Afbeelding plaatst (Image1)
Kan ik dan via een code die hierin plaatsen ?
 
Beste,

Eentje gevonden van snb met aanpassing:

Code:
Sub snb()
        Sheets(1).Shapes.AddPicture Sheets("Gereedschappenlijst").Range("F4"), False, True, Columns(6).Left, Rows(7).Top, 506, 410
End Sub

Deze werkt perfect, enkel wil ik bij het opladen van de macro dat hij de vorige foto verwijderd.
 
Beste HSV,

Deze geprobeerd maar foutmelding bij opstarten macro : Sub of Function is niet gedefinieerd

Code:
Sub HSV()
    On Error Resume Next
        Shapes("Afbeelding 1").Delete
    On Error GoTo 0
        Shapes.AddPicture Range("F4"), False, True, Columns(6).Left, Rows(7).Top, 506, 410
        Shapes(Range("F7").Value & ".jpg").Name = "Afbeelding 1"
End Sub
 
Die codes die daar geschreven zijn zijn voor een bladmodule waar de commandbuttons staan.

Jij plaatst de code in een gewone module, dan moet je overal het de bladnaam voor plaatsen of 'activesheet'.
 
Beste,

Met deze lukt het tenzij jullie iets beters gevonden hebt :-)

Code:
Sub zoeken()
    Dim myshape As Shape

    For Each myshape In ActiveSheet.Shapes
        If myshape.Type = 13 Then myshape.Delete 
    Next myshape

    Sheets("Gereedschappenlijst").Shapes.AddPicture Range("F4"), False, True, Columns(6).Left, Rows(7).Top, 506, 410
End Sub
 
Hoeveel shapes staan erin je werkblad?
 
Beste,

Eentje maar een vorm waar een macro in staat telt hij ook mee, dus 2

Gezien op de site van Ron De Bruin dat je kan kiezen tussen verschillende types 8, 12 en 13
 
Tja, ik geef de geplaatste foto een naam mee (de tekst die in het voorbeeld staat van cel B42 is de naam van de foto die ik verander in "afbeelding 1"), als die er niet is, staat er 'on error resume next'.

Geen lus voor nodig dus.
 
Laatst bewerkt:
Beste,

Hoe moet ik deze dan bewerken in Post 7 ?
 
Beste,

De naam van het plaatje die je wilt ophalen staat in F10 incl. de toevoeging ".jpg" of ".Png" of welke extensie dan ook.
De top van plaatje komt in F14 ( columns(6), rows(14).
De breedte en de hoogte moet je maar wat uitvogelen met de laatste twee getallen.

Code:
Sub hsv()
 With Sheets(1)
     On Error Resume Next
        .Shapes("Afbeelding 1").Delete
    On Error GoTo 0
        .Shapes.AddPicture [COLOR=#0000ff]"c:\users\danny\pictures\map1\"[/COLOR] & .Range("F10").Value , True, True, .Columns(6).Left, .Rows(14).Top, 506, 410
        .Shapes(.Range("F10").Value).Name = "Afbeelding 1"
   End With
End Sub
 
Beste hsv,

De volledige naam staat al in F4 met een hyperlink - ( L:\LOOPKRANEN\Afdelingen\Staalfabriek\LK100\FOTO'S\LK100 - KR KKAN R3 - Vervangen bougie\IMG_1203.jpg), hoe kan ik dan er nog iets aan toevoegen ?

Heb de code aangepast en krijg foutmelding "het item met opgegeven naam is niet gevonden"
De afbeelding krijg ik te zien bij cel F7

Code:
Sub hsv()
 With Sheets(1)
     On Error Resume Next
        .Shapes("Afbeelding 1").Delete
    On Error GoTo 0
        .Shapes.AddPicture Range("F4"), True, True, .Columns(6).Left, .Rows(7).Top, 506, 410
        .Shapes(.Range("F4").Value).Name = "Afbeelding 1"
   End With
End Sub
 
Staan die ronde haken ook in die cel?
Zo ja, verwijderen.

De fout is typisch een fout in de tekst.
Een spatie teveel/te weinig in die tekst van cel F4 gaat al fout.

Vanaf welk blad wordt de code gedraaid?, anders moet de rode punt ervoor.
Code:
 .Shapes.AddPicture [SIZE=4][COLOR=#ff0000].[/COLOR][/SIZE]Range("F4"), True, True, .Columns(6).Left, .Rows(7).Top, 506, 410
 
Beste,

In bijlage een deel van het bestandje met de 2 codes
Code Sub zoeken() werkt wel
Code hsv() werkt gedeeltelijk

Code:
Sub zoeken() 'Deze code werk perfect
Dim myshape As Shape
    On Error Resume Next
    For Each myshape In ActiveSheet.Shapes
        If myshape.Type = 13 Then myshape.Delete
    Next myshape
    On errror GoTo einde
    Sheets("Gereedschappenlijst").Shapes.AddPicture Range("F4"), False, True, Columns(6).Left, Rows(7).Top, 506, 410
einde:
    Exit Sub
End Sub

Code:
Sub hsv()
    With Sheets(1)
    On Error Resume Next
        .Shapes("Afbeelding 1").Delete
    On Error GoTo einde
        .Shapes.AddPicture Range("F4"), True, True, .Columns(6).Left, .Rows(7).Top, 506, 410
        .Shapes Range("F4").Value.Name = "Afbeelding 1"
    End With
einde:
   Exit Sub
End Sub
 

Bijlagen

Als je 'on error goto einde' doet, kom je er ook niet achter wat er fout gaat.

Code:
Sub hsv()
    With Sheets("Gereedschappenlijst")
    On Error Resume Next
        .Shapes("Afbeelding 1").Delete
    On Error GoTo 0
        .Shapes.AddPicture .Range("F4").Value, True, True, .Columns(6).Left, .Rows(7).Top, 506, 410
        .Shapes(Split(.Range("F4").Value, "\")(UBound(Split(.Range("F4").Value, "\")))).Name = "Afbeelding 1"
    End With
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan