Opgelost Fotos plaatsen in een range

[HWV]

Goedendag,

Ik heb een code die een foto plaats in een cel.

Range("H3").Select
If Range("H3") = "" Then
Else
ActiveCell.InsertPictureInCell "C:\Users\***.***\OneDrive - ***\***\***\***\" & [H3] & ".JPG"
End If

Range("I3").Select
If Range("I3") = "" Then
Else
ActiveCell.InsertPictureInCell "C:\Users\***.***\OneDrive - ***\***\***\***\" & [I3] & ".JPG"
End If

Range("J3").Select
If Range("J3") = "" Then
Else
ActiveCell.InsertPictureInCell "C:\Users\***.***\OneDrive - ***\***\***\***\" & [J3] & ".JPG"
End If

Maar dit moet ik dan voor elke cel maken. Kan ik dit ook laten vullen met een soort range of loop.
Ik kom er maar niet verder mee, dus dacht een beetje hulpheb ik wel nodig.
De foto`s moeten komen in de kolomen H, I en J t/m rij 350
Maar er zitten ook lege regels tussen, waar niks staat dus die moeten worden overgeslagen, evenals er een foto nummer niet bestaat. De waarde die in de cellen staan 1, 2, 3 enz zijn de foto namen in .jpg

Alvast dank voor de hulp.

Henk

 

[emields]

Je vergeet blijkbaar dat excel een rekenblad is en geen fotoalbum.

 

[HWV]

Dank voor de reactie Emields.
Dat weet ik, maar we maken een looplijst voor de gebreken voor de BRC.
Dus dan wil ik bij de gevonden problemen, er foto`s bij hebben.

Groet Henk

 

[HWV]

Sub VoegAfbeeldingenToeInKolommenHIJ2()
    Dim ws As Worksheet
    Dim afbeeldingPad As String
    Dim afbeeldingNaam As String
    Dim cel As Range
    Dim volledigePad As String

    ' De werkmap en het tabblad instellen
    Set ws = ThisWorkbook.Sheets("*** - Looplijst F15.3a")

    ' Map waar de afbeeldingen zich bevinden
    afbeeldingPad = "C:\Users\****.***\OneDrive - **** BV\Logistiek\Verpakkingen\Afbeeldingen\"

    ' Loop door kolommen H, I en J
    For Each cel In ws.Range("H2:J" & ws.Cells(ws.Rows.Count, "H").End(xlUp).Row)
        If cel.Value <> "" Then
            ' De volledige pad van de afbeelding opstellen
            afbeeldingNaam = cel.Value & ".jpg"
            volledigePad = afbeeldingPad & afbeeldingNaam

            ' Controleer of de afbeelding bestaat
            If Dir(volledigePad) <> "" Then
                ' Selecteer de cel en gebruik InsertPictureInCell
                cel.Select
                ActiveCell.InsertPictureInCell volledigePad
            Else
               '' MsgBox "Afbeelding niet gevonden: " & volledigePad, vbExclamation
            End If
        End If
    Next cel
End Sub

Dit doet wat ik zocht, dus heeft zich zelf opgelost

Henk

 

[OctaFish]

Dit werkt:

Sub Foto_Plaatsen()
Dim sht As Worksheet
Dim i As Integer, j As Integer
Dim shp As Variant

    Set sht = ActiveSheet
    For j = 3 To 350
        For i = 8 To 10
            If Not Cells(j, i) = "" Then
                Cells(j, i).InsertPictureInCell "C:\Users\***.***\OneDrive - ***\***\***\***\" & Cells(j, i) & ".jpg"
                With shp
                    .Width = sht.Cells(j, i).Width
                    .Height = sht.Cells(j, i).Height
                    .Left = sht.Cells(j, i).Left
                    .Top = sht.Cells(j, i).Top
                    .Placement = 1
                End With
            End If
        Next i
    Next j

End Sub

 

[JEC.]

Kijk eens naar de IMAGE functie. Ik zou inderdaad ook niet alle foto's in je document plaatsen. Roep alleen degene op die je wilt zien.

Je kan deze functie gebruiken maar verwijs dan wel naar je https pad van je foto. Dus niet je lokale pad.

=IMAGE("https://xxxx.sharepoint.com/sites/xxxx-xxxx/Shared%20Documents/folderX/jeFoto.jpg";;1)

 

[HWV]

Dank allen voor de bijdrage, ik ga ermee aan de gang

Henk