Import and rotate image

[Hatye]

Hi,

I have a macro that imports image, and has worked out great until now. The problem now is that I need to rotate the picture 90#, and after it has been rotated I need it to "start" in a certain cell (B51).

I hope someone can help me to place the image in right cell

Sub InsertPicture()

Dim myPicture
Dim MyOpj As Object

myPicture = Application.GetOpenFilename _
("Bilder (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", _
, "Velg bilde som skal settes inn")
If VarType(myPicture) = vbBoolean Then Exit Sub

If myPicture = "False" Then Exit Sub

Set MyObj = Ark1.Pictures.Insert(myPicture)

    With MyObj
        With .ShapeRange
        .LockAspectRatio = msoFalse
        .IncrementRotation 90#
        .Height = 350
        .Width = 500
        .Top = Ark1.Range("B51").Top
        .Left = Ark1.Range("B51").Left
        End With
    .Placement = xlMoveAndSize
    End With

Set MyObj = Nothing

End Sub

 

[MickG]

It seems to do what you want , but this:-

Dim MyOpj As Object

Should be This:-

Dim MyObj As Object

 

[Hatye]

No, that didn't seem to fix it.
The problem is that it is originally inserted into correct cell (B51), but when it is rotated I think it rotates around its center point, and therefore the placement isn't correct.

 

[Hatye]

Anyone?

 

[MickG]

This should do what you want:-

[COLOR="Navy"]Sub[/COLOR] MG27Apr34
[COLOR="Navy"]Dim[/COLOR] myPicture
[COLOR="Navy"]Dim[/COLOR] MyObj [COLOR="Navy"]As[/COLOR] Object
myPicture = Application.GetOpenFilename _
("Bilder (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", _
, "Velg bilde som skal settes inn")
[COLOR="Navy"]If[/COLOR] VarType(myPicture) = vbBoolean [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]If[/COLOR] myPicture = "False" [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]Set[/COLOR] MyObj = ActiveSheet.Pictures.Insert(myPicture)
 
    
    [COLOR="Navy"]With[/COLOR] MyObj
        [COLOR="Navy"]With[/COLOR] .ShapeRange
            .LockAspectRatio = msoFalse
            .IncrementRotation 90#
            .Height = 350
            .Width = 500
            .Left = Range("B52").Left - (.Width - .Height) / 2
            .Top = Range("B52").Top + (.Width - .Height) / 2
        [COLOR="Navy"]End[/COLOR] With
            .Placement = xlMoveAndSize
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] MyObj = Nothing
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick