AddTextBox Position Fix
 

Hi,

I am trying to add a textbox shape to a cell but the zoom level seems to
effect its position. Does anyone know a way of calculating the correct
position regardless of zoom level?

The problem can be seen by running this code:

Sub AddTextBoxesAtDifferentZoomLevels()
Dim rngCell As Range
Dim sngWidthHeight As Single
Dim iZoom As Integer
Dim ioff As Integer
Dim Irow As Integer
'note: row height also affects the layout
sngWidthHeight = 10
For Irow = 1 To 201 Step 50
Set rngCell = Range("A1").Cells(Irow, 1)
ioff = 0
For iZoom = 10 To 200 Step 10
ActiveWindow.Zoom = iZoom
rngCell.Offset(0, ioff) = iZoom
Set shpNew =
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHo rizontal, rngCell.Offset(0,
ioff).Left, rngCell.Top, sngWidthHeight, sngWidthHeight)
ioff = ioff + 1
Next
Next
End Sub


Note each box is supposed to be in a cell on row 0,50,100,150 or 200.

--
Thanks, Matt