Foto invoegen met VBA

[Roma]

Specialisten,
Ik heb op dit forum en vba code gevonden om een jpg file in te voegen.(bijlage)
Graag wil ik de jpg file meerdere keren invoegen(allemaal de zelfde)
Wie kan mij helpen met de oplossing

Ron

 

[edmoor]

Schakel deze twee regels uit in de Sub MyPic:
OldShapesDel
Range("j21").Select

 

[Roma]

beste Edmoor,
bedankt voor je reactie. Ik wil graag dat ze allemaal tegelijk ingevoegd worden (tussen de 30 en 35 stuks in de J range
lukt j dat ook?

 

[edmoor]

Tuurlijk, maar dan zal je moeten vertellen in welke cellen je die 30 tot 35 foto's je wilt hebben en ik welke cel de eerste moet staan.

 

[Roma]

Ze moeten in de cellen JKL 15-16-17 (samengevoegd) en vervolgens elke keer met 10 cellen vermeerderd (35 maal)

 

[Warme bakkertje]

Sub MyPic()
    Dim sPicture As String, i As Integer, j As Integer
    ActiveSheet.Unprotect
    sPicture = Application.GetOpenFilename _
        ("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
        , "Select Picture to Import")
    If sPicture = "False" Then Exit Sub
    'OldShapesDel 'terug inschakelen na 1ste run
    j = 15
    For i = 1 To 35
        Set p = ActiveSheet.Pictures.Insert(sPicture)
        With p
            .ShapeRange.LockAspectRatio = msoFalse
            .Name = "Foto" & i
            .Height = 80
            .Width = 85
            .Top = Cells(j, 10).Top
            .Left = Cells(j, 10).Left
            .Placement = xlMoveAndSize
        End With
        With .ShapeRange
            .ScaleWidth 0.97, msoFalse, msoScaleFromBottomRight
            .ScaleHeight 0.96, msoFalse, msoScaleFromBottomRight
            .ScaleHeight 0.94, msoFalse, msoScaleFromTopLeft
            .ScaleWidth 0.96, msoFalse, msoScaleFromTopLeft
        End With
        j = j + 10
        Set p = Nothing
    Next
    Range("b7").Select
    ActiveSheet.Protect
End Sub
Sub OldShapesDel()
    For i = 1 To 35
        ActiveSheet.Shapes("Foto" & i).Delete
    Next
End Sub

 

[Roma]

Rudi,
Ziet er goed uit bedankt. Helaas zit e nog een foutje in. zie bijlage
Bekijk bijlage 214567

 

[Warme bakkertje]

Jij hebt zelf gezegd telkens met 10 cellen te vermeerderen
En trouwens, deze had je toch zelf ook wel kunnen bedenken.

j = j + 12

 

[Roma]

Beste Rudi,
Inderdaad stom van mij. Het werkt nu super :thumb:. Ik heb de code nog wat aangepast.
Bedankt voor het meedenken
Ron