Bug? Aligning Shapes to Cell dimensions is now not and exact match?

[vbavirgin]

Hi all,

I have a macro that fills a textbox with a picture from a URL and aligns the textbox to a cell.

Sub FillPic()

Dim i As Long, URL As String
Dim oTextBox As TextBox

For Each oTextBox In ActiveSheet.TextBoxes
    oTextBox.Delete
Next oTextBox
  
    i = 2
    Do While Len(ActiveSheet.Cells(i, 1).Text) > 0

    URL = ActiveSheet.Cells(i, 1).Text

        With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50)
            .Left = ActiveSheet.Cells(i, 2).Left
            .Top = ActiveSheet.Cells(i, 2).Top
            .Height = ActiveSheet.Cells(i, 2).Height
            .Width = ActiveSheet.Cells(i, 2).Width
            .Fill.UserPicture URL
            On Error Resume Next
        End With
      
        i = i + 1
    Loop

End Sub

The issue I have is that the alignment is not 100% exact so that all the textboxes are created row by row they start to align out of sync with the cells (see image).

This never used to be the case when using an older version of excel but is now an annoying issue.!!

Has anyone else noticed this? Can somebody help me with this so that the textboxes align exactly with the cells?

Thanks,

Lewis

 

[JB2020]

Seems to work ok for me. Have you tried switching round the order of your With? i.e. do the Fill first and set the Top property last?

 

[vbavirgin]

Seems to work ok for me. Have you tried switching round the order of your With? i.e. do the Fill first and set the Top property last?

Hi JB2020,

Thanks for replying.

I have tried different combinations but I still get the slight misalignment. What version of excel are you using?

 

[RoryA]

Is your sheet zoom set to anything other than 100%?

 

[JB2020]

Hi JB2020,

Thanks for replying.

I have tried different combinations but I still get the slight misalignment. What version of excel are you using?

I'm using 365. How about something like this?

        With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50)
            .Fill.UserPicture URL
            On Error Resume Next
            .LockAspectRatio = False
            .Height = ActiveSheet.Cells(i, 2).Height
            .Width = ActiveSheet.Cells(i, 2).Width
            .Left = ActiveSheet.Cells(i, 2).Left
            .Top = ActiveSheet.Cells(i, 2).Top
        End With

Also, have you checked the .Top property of the cell compared to the .Top property of the image after running it? If so, are they the same?

 

[vbavirgin]

Hi JB2020,

Thanks for replying.

I have tried different combinations but I still get the slight misalignment. What version of excel are you usin

Is your sheet zoom set to anything other than 100%?

Hi RoryA,

Thanks for replying.

I have tried at 100% and different variations as well as different row heights. still no joy

 

[vbavirgin]

I'm using 365. How about something like this?

        With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50)
            .Fill.UserPicture URL
            On Error Resume Next
            .LockAspectRatio = False
            .Height = ActiveSheet.Cells(i, 2).Height
            .Width = ActiveSheet.Cells(i, 2).Width
            .Left = ActiveSheet.Cells(i, 2).Left
            .Top = ActiveSheet.Cells(i, 2).Top
        End With

Also, have you checked the .Top property of the cell compared to the .Top property of the image after running it? If so, are they the same?

I have tried all manner of different combos. I also checked for the aspect ratio lock. The above did not change the outcome. I am using 365 also.

How do I check the top property of the picture?

Despite my rows being the same height, the textbox heights differ e.g. one will be 0.44cms, another will be 0.45cm and another 0.46. This is what seems to be the issue....

Can you try resizing cells and running to see if you get any issues?

 

[JB2020]

I have tried all manner of different combos. I also checked for the aspect ratio lock. The above did not change the outcome. I am using 365 also.

How do I check the top property of the picture?

Despite my rows being the same height, the textbox heights differ e.g. one will be 0.44cms, another will be 0.45cm and another 0.46. This is what seems to be the issue....

Can you try resizing cells and running to see if you get any issues?

The easiest way would just be to hold alt and resize the picture and see if it will change size to match the cell. Alternatively you could put something like this in your code temporarily to compare them:

MsgBox "Shape top: " & .Top & vbNewLine & "Cell top: " & ActiveSheet.Cells(i, 2).Top

 

[RoryA]

Is your sheet in normal view, or one of the page layout views?

 

[vbavirgin]

Is your sheet in normal view, or one of the page layout views?

Normal view