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

Positie van een plaatje

Status
Niet open voor verdere reacties.
E

Excel dick

Gebruiker
Lid geworden
22 sep 2008
Berichten
23
Beste,

Ik probeer plaatjes in een werkblad in te voegen met:

Code: 
Sub InsertPicture()
Dim i As Integer
i = 2
Do Until Cells(3, i).Value = ""
With ActiveSheet.Pictures.Insert( _
    ThisWorkbook.Path & "\" & Cells(3, i).Value)
    .Top = Cells(2, i).Top
    .Left = Cells(2, i).Left
    .Width = (.Width / .Height) * Cells(i, 2).Height
    .Height = Cells(i, 2).Height
     End With
i = i + 1
Loop
End Sub

Nu worden de plaatjes met de bovenkant op de bovenkant van het plaatje uitgelijnd, ik wil ze graag op de onderkant uitlijnen...kan dat met VBA ??

Heel veel dank voor jullie tips!!
 
Laatst bewerkt door een moderator:
Bedoel je dit?

Code: 
.Width = (.Width / .Height) * Cells(i, 2).Height
.Height = Cells(i, 2).Height

zou dit moeten zijn?

Code: 
.Width = (.Width / .Height) * Cells(2, i).Height
.Height = Cells(2, i).Height

Was een type foutje waarschijnlijk.
 
Bekijk bijlage InsertPicture.zip

Dank je wel Jolivanes,

Dat was inderdaad een foutje, maar het omschreven probleem blijft!

Ik heb een test je toegevoegd om het probleem wat beter te schetsen. Het is de bedoeling dat het plaatje zich aanpast aan de kolom breedte en niet de hoogte. Uiteindelijk moet het plaatje aan de onderkant van de cel staan.

Alvast dank voor jullie hulp.
 
Had je dit in gedachten?


Code: 
Sub InsertPicture_A()
    Dim i As Integer
    Dim a As Long
    i = 2
    Do Until Cells(3, i).Value = ""
        With ActiveSheet.Pictures.Insert( _
             ThisWorkbook.Path & "\" & Cells(3, i).Value): .Name = "Pic" & i
            .Top = Cells(2, i).Top
            .Left = Cells(2, i).Left
            .Width = Cells(2, i).Width
        End With
        ActiveSheet.Shapes("Pic" & i).Select
        a = Selection.ShapeRange("Pic" & i).Height
        Selection.ShapeRange.IncrementTop Cells(2, i).Height - a
        i = i + 1
    Loop
End Sub
 
Laatst bewerkt door een moderator:
Gebruik de methode shapes.addpicture; alles in 1 regel
 
Dank voor jullie hulp.
Kunnen jullie me een tip geven voor een goede fout afhandeling als het plaatje niet beschikbaar is?

Dank jullie wel Dick
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan