Stacking Pictures Vertically VBA

[jlhoover3]

Hello everyone!

I am having problems figuring out a way to stack images or place images vertically on excel. When saying that, I want to insert a picture and have it move directly below the previous image that was inserted. Usually this wouldn't be a problem, however the images have a different height and so I'm not sure how to do this. Any help would be great and hoping this is making sense. Thanks for you time!

 

[shg]

After inserting a picture, you can use its Top and Height properties to calculate the Top property for the next picture.

 

[jlhoover3]

After inserting a picture, you can use its Top and Height properties to calculate the Top property for the next picture.

Thanks for the reply. Still a little bit confused on how i can place the image right below the previous image. This is what I have below, thanks!

Sub BrandImage()Dim r As Range
Dim WS As Worksheet
Dim imagePath As String
Dim img As Picture


Set WS = Worksheets("PictureTest")
Set r = WS.Range("E4:H16")
imagePath = Range("A1").Value
Set img = WS.Pictures.Insert(imagePath)
img.Name = "Brand"
With img
    .ShapeRange.LockAspectRatio = msoTrue
    .Height = r.Height
    .Top = r.Top
    .Left = r.Left
End With


Set s = r
imagePath = Range("A2").Value
Set img = WS.Pictures.Insert(imagePath)
img.Name = "Type1"
With img
    .ShapeRange.LockAspectRatio = msoTrue
    .Left = s.Left
    .Height = s.Height
    .Top = s.Top
    
End With


End Sub

 

[shg]

For example,

Sub BrandImage()
  Dim wks           As Worksheet
  Dim cell          As Range
  Dim pic           As Picture
  Dim dTop          As Double
  Dim dLft          As Double

  Set wks = Worksheets("PictureTest")
  wks.Select  ' not necessary, but allows you to watch
  With wks.Range("E4")
    dTop = .Top
    dLft = .Left
  End With

  For Each cell In Range("A1:A10")  ' paths & filenames
    With cell
      If Len(.Text) > 0 And Len(Dir(.Text)) > 0 Then
        Set pic = wks.Pictures.Insert(.Text)
        With pic
          .ShapeRange.LockAspectRatio = msoTrue
          .Width = 100
          .Left = dLft
          .Top = dTop
          .Name = cell.Offset(, 1).Text ' names in col B
          dTop = dTop + .Height
        End With
      End If
    End With
  Next cell
End Sub

 

[jlhoover3]

For example,

Sub BrandImage()
  Dim wks           As Worksheet
  Dim cell          As Range
  Dim pic           As Picture
  Dim dTop          As Double
  Dim dLft          As Double

  Set wks = Worksheets("PictureTest")
  wks.Select  ' not necessary, but allows you to watch
  With wks.Range("E4")
    dTop = .Top
    dLft = .Left
  End With

  For Each cell In Range("A1:A10")  ' paths & filenames
    With cell
      If Len(.Text) > 0 And Len(Dir(.Text)) > 0 Then
        Set pic = wks.Pictures.Insert(.Text)
        With pic
          .ShapeRange.LockAspectRatio = msoTrue
          .Width = 100
          .Left = dLft
          .Top = dTop
          .Name = cell.Offset(, 1).Text ' names in col B
          dTop = dTop + .Height
        End With
      End If
    End With
  Next cell
End Sub

I never thought of using a For Statement for this situation. I appreciate everything!!!! Works perfectly

 

[shg]

You're welcome.