Adding shapes using VBA macro

[JennyLyons]

Hello! My name is Jenny and I am working on some code that will insert 6 rectangle shapes based on corresponding length and width values that are in 12 separate cells. I got the code figured out to do this, but the calculation doesn't seem to 100% be working. I realized that VBA reads things in pts. Therefore, I used a formula to transition the length/width values that were in inches into points (I just multiplied the value by 72). The problem is that it isn't inserting shapes that are the correct size. You can really see this when I make all 6 shapes into what should be perfect squares. When the shapes are inserted, not all 6 squares are "perfect". In the file attached, you will see that when you click on Rectangles 1-4, their heights are .01 off. Rectangle 5 and 6 seem to be fine.

Can anyone help me fix this? I welcome any ideas and suggestions. Thank you!

Link to file: https://drive.google.com/file/d/1vXfO06sX_Ud51Jcinmp7mOolfwMEtN5u/view?usp=sharing

 

[mrshl9898]

I cannot see the code you are using in that file.

But this is working for me:

Sub Macro1()'
' Macro1 Macro
'
Dim p1 As Long
Dim p2 As Long
Dim h1 As Long
Dim w1 As Long
Dim colnum As Long
Dim pos1 As Long


colnum = 9
pos1 = 100


Do Until colnum = 15


pos1 = pos1 + 100
p1 = pos1
p2 = 100
h1 = Cells(2, colnum)
w1 = Cells(3, colnum)


ActiveSheet.Shapes.AddShape(msoShapeRectangle, p1, p2, h1, w1).Select
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset8
    
colnum = colnum + 1
    
Loop


End Sub

 

[mrshl9898]

Was able to dl your file. I see what you mean now.


Interestingly when you run my code and compare the shape dimensions I get this:

1- 1.41 * 1.4 vs 1.41 * 1.4
2- 1.28 * 1.27 vs 1.27 * 1.26
3- 1.03 * 1.01 vs 1.02 * 1.02

It seems it has nothing to do with the Height and Width properties, nor can I find anything else to adjust in the Shape object.... Unfortunately Square isn't a type of Shape either.

I did have a fair degree of success by multiplying the Height by 1.011 to get the Width. Though this was not perfect...

 

[JennyLyons]

Hello mrshl9898

Thank you SO much for taking the time to help me out. It is the weirdest thing. Bummer we can't get it solved. The difference is minor, but it is still mind-boggling. Do you think that shape height uses a different pt to inch conversion or something? The weird thing is that it doesn't happen for every square, so it is hard to tell what the issue is.

Thanks again!

*If anyone else has any ideas or has had this issue, I am open to any more thoughts.*

 

[mrshl9898]

I have had other what I call "Scaling Issues" in Excel before, even between PCs. Where the Height and Width of columns or items doesn't appear the same.

My only thought is it has something to do with screen settings.

It has nothing to do with the conversion, if you record a macro and adjust the width and height manually you get this:

    Selection.ShapeRange.Width = 39.6
    Selection.ShapeRange.Height = 39.6

But as soon as you run the macro you end up with the same issue as you have.

You may just have to find out what number you need to multiply the width or height by in order to make a square. There will be a number there, maybe make a massive square and look at the width and height and divide the numbers by one another.

I made a square 100000 x 100000 pts, the Height was 3527.78 and width 3501.83, giving me a conversion of 1.0074104111279. After I multiplied the Width by that the shapes were Square except Rectangle 3.

That's as close as I seem to be able to get.

 

[Fluff]

It's down to the zoom setting.
If you change the Zoom to 100% all the squares are squares.

 

[JennyLyons]

Thanks for all your help brainstorming mrshl9898. Fluff's comment on changing the zoom setting seemed to be the key. I always work zoomed out at like 65-70% so when I changed the document to 100%, the square issue was gone. Cool!

Thanks again

 

[Fluff]

Glad we could help & thanks for the feedback