Picture: Click on picture to enlarge, click again to go back to original size

[Figol]

Hello, this is my first post, I love Excel but I am not an expert.
I have made an Excel file that contains a lot of pictures and with the VBA code below I can enlarge a picture by clicking on it and bring it back to its original size by clicking on the picture again.
Everything works fine, until I open the Excel file on my second computer. Many of the pictures are distorted and have a different smaller size.
When i click on a pictures it enlarges and when I click again to bring it to its original size, all of a sudden the size of the picture is OK, but it has shifted a few mm to the right.
Anybody that can help me with a solution?

Best regards,

Figol

Sub PYZ_11_Click()
ActiveSheet.Unprotect
Dim big As Single, small As Single
Dim shpDouH As Double, shpDouOriH As Double
big = 0.3
small = 0.09
On Error Resume Next
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp
shpDouH = .Height
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
shpDouOriH = .Height

If Round(shpDouH / shpDouOriH, 2) = big Then
.ScaleHeight small, msoTrue, msoScaleFromTopLeft
.ScaleWidth small, msoTrue, msoScaleFromTopLeft
.ZOrder msoSendToBack
Else
.ScaleHeight big, msoTrue, msoScaleFromTopLeft
.ScaleWidth big, msoTrue, msoScaleFromTopLeft
.ZOrder msoBringToFront
End If
End With
End Sub

 

[GWteB]

Hi & welcome to MrExcel.

Not sure whether it will resolve your issue, but try both locking the aspect ratio of the shape and setting its placement to xlMove rather than xlMoveAndSize.
That way the change of any column width or row height on your sheet will not have an effect on your shape's appearance.
Btw, once the aspect ratio is locked changing the scale height will also affect the scale width.

Sub PYZ_11_Click()
    ActiveSheet.Unprotect
    Dim big As Single, small As Single, shp As Shape
    Dim shpDouH As Double, shpDouOriH As Double
    big = 0.3
    small = 0.09
    On Error Resume Next
    Set shp = ActiveSheet.Shapes(Application.Caller)
    With shp
        .LockAspectRatio = msoTrue
        .Placement = xlMove
        shpDouH = .Height
        .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
        shpDouOriH = .Height

        If Round(shpDouH / shpDouOriH, 2) = big Then
            .ScaleHeight small, msoTrue, msoScaleFromTopLeft
            .ScaleWidth small, msoTrue, msoScaleFromTopLeft
            .ZOrder msoSendToBack
        Else
            .ScaleHeight big, msoTrue, msoScaleFromTopLeft
            .ScaleWidth small, msoTrue, msoScaleFromTopLeft
            .ZOrder msoBringToFront
        End If
    End With
End Sub

 

[Figol]

Dear GWteB,

Thank you for your your advice, I really appreciate this very much.
I applied the changes to my Code, but unfortunately it did not resolve the issue.
Anyhow, thank you very much.
Best regards,
Figol

 

[GWteB]

You're welcome and thanks for the follow-up. Too bad it didn't seem to solve your problem.