• 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.

Afbeelding invoegen of insluiten in een cel of celbereik

Status
Niet open voor verdere reacties.
Georgyboy

Georgyboy

Terugkerende gebruiker
Lid geworden
6 jan 2007
Berichten
1.005
Besturingssysteem
Windows 11
Office versie
365
Hallo iedereen,

Ik zou een productcatalogus willen maken in excel.
Is het mogelijk om een afbeelding in één cel of celbereik in te voegen?

Kan men een afbeeldingsframe invoegen in één cel of bereik?

Groeten,
Georgyboy
 
Bedankt voor je info Rudi,

Het is niet helemaal wat ik bedoel, maar zeker bruikbaar voor andere toepassingen.

wat ik bedoel is de foto (insluiten) of invoegen in een cel en dat het past in de afmeting
van de cel. Wanneer we de cel vergroten of verkleinen dat de foto zich aanpast.

Kan dit ?

Alvast bedankt,
Georgyboy
 
Probeer onderstaande eens

Code: 
Sub test()
    On Error Resume Next
    Set pic = ActiveSheet.Pictures.Insert("pad naar afbeelding")
    On Error GoTo 0
    If Not pic Is Nothing Then
        Set rng = ActiveCell
        With pic
            .Height = rng.Height
            .Width = rng.Width
            .Left = rng.Left
            .Top = rng.Top
            .Placement = xlMoveAndSize
        End With
    End If
End Sub

Mvg

Rudi
 
Dag Rudi,

Bedankt voor je info,

Ik krijg een compileerfout bij "Pic" variabele niet gedefinieerd

Kan men een foto slepen in de cel en dat het formaat word aangepast ?

Groeten,
Georgyboy
 
Option Explicit bovenaan de code verwijderen ?
Heb je de code in een gewone module geplaatst en het correcte pad opgegeven, want hier werkt het foutloos ?

Mvg

Rudi
 
Laatst bewerkt:
Dag Rudi,

Bedankt voor je hulp,
maar sorry ik kom er niet uit of beter gezegt ik snap het niet.

Staat in de code:
Code: 
Set pic = ActiveSheet.Pictures.Insert("D:\Mijn    afbeeldingen\2-9-2005")

In cel (Vb. C3
Code: 
(D:\Mijn    afbeeldingen\2-9-2005"BBQ 1 september '05 001")

Alvast bedankt,
Georgyboy
 
Je moet het volledige pad naar de foto inclusief fotonaam invullen, dus bv
De foto wordt dan in de active cel geplaatst
Code: 
Set pic = ActiveSheet.Pictures.Insert("D:\Mijn documenten\Mijn afbeeldingen\GevelCalesberg.jpg")

Mvg

Rudi
 
Ik heb 'm ondertussen wat aangepast.
Bij het starten v/d macro wordt een,scherm geopend waar je de foto kan selecteren zodat je niet steeds de macro moet aanpassen

Code: 
Sub test()
Dim ImgFileFormat As String, pic As Variant
On Error Resume Next
ImgFileFormat = "Image Files jpg (*.jpg),*.jpg,(*.bmp),others, tif (*.tif),*.tif"
Set pic = ActiveSheet.Pictures.Insert(Application.GetOpenFilename(ImgFileFormat))
On Error GoTo 0
    If Not pic Is Nothing Then
        Set rng = ActiveCell
        With pic
            .Height = rng.Height
            .Width = rng.Width
            .Left = rng.Left
            .Top = rng.Top
            .Placement = xlMoveAndSize
        End With
    End If
End Sub

Mvg

Rudi
 
Bedank Rudi,

Dit is helemaal TOP !

Fantastisch wat je kan!

Groeten, Georgyboy
 
Laatst bewerkt:
Foto via hyperlink openen in een cel

Hallo,

Sorry ik heb nog een bijkomende vraag,
wat ik reeds heb is geweldig goed Rudi,

Maar kan men een foto openen via een hyperlink of bestandsnaam
en deze in een andere cel plaatsen.

Nu kan ik de foto openen via de hyperlink,dan opent picture manager, dan zou ik die foto op geweste grote in een cel willen plaatsen.Kan dit automatisch met een macro ?

Zie bijlage

Alvast bedankt,
Georgyboy
 

Bijlagen

Probeer onderstaande eens

Mvg

Rudi
 

Bijlagen

Laatst bewerkt:
Bedankt Rudi,

echt knap !

ik probeer het even te verstaan om in andere toepassingen te gebruiken.

Nu staat :
in kolom F het betand en pad
in kolom H de hyperlink (=hyperlink(uit kolom F)
dan voer ik Uw macro uit
en zo zie ik de foto in kolom G

Ik zal proberen dit voor andere excel toepassingen te gebruiken,
kunnen we dit nog vereenvoudigen.

Alvast bedankt!
Georgyboy
 
Georgyboy, ik heb het voorbeeld in vorige post uitgebreid met een woordje uitleg.
De hyperlink heeft geen enkel nut in de uitvoering en mag eventueel verwijderd worden

Mvg

Rudi
 
Array aanpassn voor meer of minder foto´s

Dag Rudi,

bedankt voor je inspanningen

De code werkt perfect Tot G7

Kan men dit uitbreiden of beter willekeurig de ene keer 5 foto´s de andere keer mogelijk 100 foto´s, afhankelijk van de artikellijst.

Code: 
ub Insert_Pict1()
    Dim lRow As Long, lLoop As Long
    Dim sShape As Shape, myarray As Variant
        'Plaats alle bestanden in kolom F in een array
        myarray = Range("F2:F7").Value
        myarray = Application.WorksheetFunction.Transpose(myarray)
        ActiveSheet.Protect False, False, False, False, False
GetPict:
    'als slechts 1 bestand in array zit foutmelding en exit
    If Not IsArray(myarray) Then
        Debug.Print "No files selected."
        Exit Sub
    End If
    lRow = 2 'startrij om de foto's te plaatsen
    'aantal bestanden tellen om de loop uit te voeren
    For lLoop = LBound(myarray) To UBound(myarray)
    'foto plaatsen op lrow en kolom 7(G) + formaat bepalen v/d foto
    Set sShape = ActiveSheet.Shapes.AddPicture(myarray(lLoop), msoFalse, msoCTrue, _
            Cells(lRow, 7).Left, Cells(lRow, 7).Top, Cells(lRow, 7).Width, Cells(lRow, 7).Height)
        With sShape
            .Placement = xlMoveAndSize 'foto vastzetten om te bewegen met het celformaat
        End With
    lRow = lRow + 1 'volgende rij selecteren
Next lLoop 'volgende foto in de array plaatsen
End Sub

Waarom 5 x false ?
Code: 
ActiveSheet.Protect False, False, False, False, False

Alvast bedankt,
Georges
 
Op deze manier wordt hij variabel

Code: 
myarray = Range("F2", Range("F65536").End(xlUp)).Value

Mvg

Rudi
 
Bedankt Rudi,

Getest,

Fout :1004 --> het opgegeven bestand is niet gevonden

Code: 
[COLOR="Red"][/COLOR]Set sShape = ActiveSheet.Shapes.AddPicture(myarray(lLoop), msoFalse, msoCTrue, _
            Cells(lRow, 7).Left, Cells(lRow, 7).Top, Cells(lRow, 7).Width, Cells(lRow, 7).Height)

Code: 
Sub Insert_Pict1()
    Dim lRow As Long, lLoop As Long
    Dim sShape As Shape, myarray As Variant
        'Plaats alle bestanden in kolom F in een array
       myarray = Range("F2", Range("F65536").End(xlUp)).Value
        myarray = Application.WorksheetFunction.Transpose(myarray)
        ActiveSheet.Protect False, False, False, False, False
GetPict:
    'als slechts 1 bestand in array zit foutmelding en exit
    If Not IsArray(myarray) Then
        Debug.Print "No files selected."
        Exit Sub
    End If
    lRow = 2 'startrij om de foto's te plaatsen
    'aantal bestanden tellen om de loop uit te voeren
    For lLoop = LBound(myarray) To UBound(myarray)
    'foto plaatsen op lrow en kolom 7(G) + formaat bepalen v/d foto
    Set sShape = ActiveSheet.Shapes.AddPicture(myarray(lLoop), msoFalse, msoCTrue, _
            Cells(lRow, 7).Left, Cells(lRow, 7).Top, Cells(lRow, 7).Width, Cells(lRow, 7).Height)
        With sShape
            .Placement = xlMoveAndSize 'foto vastzetten om te bewegen met het celformaat
        End With
    lRow = lRow + 1 'volgende rij selecteren
Next lLoop 'volgende foto in de array plaatsen
End Sub
 
Kijk alles eens goed na want onderstaande werkt, of ik nu 2 bestanden of 20 bestanden plaats

Code: 
Sub Insert_Pict1()
    Dim lRow As Long, lLoop As Long
    Dim sShape As Shape, myarray As Variant
        myarray = Range("F2", Range("F65536").End(xlUp)).Value
        myarray = Application.WorksheetFunction.Transpose(myarray)
        ActiveSheet.Protect False, False, False, False, False
GetPict:
    If Not IsArray(myarray) Then
        MsgBox "Slechts 1 bestand geselecteerd."
        Exit Sub
    End If
    lRow = 2
    For lLoop = LBound(myarray) To UBound(myarray)
    Set sShape = ActiveSheet.Shapes.AddPicture(myarray(lLoop), msoFalse, msoCTrue, _
            Cells(lRow, 7).Left, Cells(lRow, 7).Top, Cells(lRow, 7).Width, Cells(lRow, 7).Height)
        With sShape
            .Placement = xlMoveAndSize
        End With
    lRow = lRow + 1
Next lLoop
End Sub

Mvg

Rudi
 
Dag Rudi,

Ik heb het nogmaals geprobeerd en ik krijg foto´s ingevoegd tot en met G8
verder komen geen foto´s.

Verder foutmelding : Fout :1004 --> het opgegeven bestand is niet gevonden

Groeten,
Georges
 
Mij lijkt het dan dat ofwel de bestandsnaam(met het juiste en volledige pad) niet correct is ingevoerd of het bestand niet aanwezig is, want hier plaatste hij 50 foto's in minder dan 2 sec.

Mvg

Rudi
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan