Search code examples
excelvbaimageuserform

Rotate picture in user form

I'm trying to rotate an image inside an user form, here is the cose I'm using:

Private Declare Function GetTempPath Lib "kernel32" Alias"GetTempPathA_(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Dim NewPath As String

Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function

Sub RotatePic(deg As Long)
Dim ws As Worksheet
Dim p As Object
Dim chrt As Chart

'~~> Adding a temp sheet
Set ws = ThisWorkbook.Sheets.Add

'~~> Insert the picture in the newly created worksheet
Set p = ws.Pictures.Insert(**PROBLEM**)

'~~> Rotate the pic
p.ShapeRange.IncrementRotation deg

'~~> Add a chart. This is required so that we can paste the picture in it
'~~> and export it as jpg
Set chrt = Charts.Add()

With ws
    '~~> Move the chart to the newly created sheet
    chrt.Location Where:=xlLocationAsObject, Name:=ws.Name

    '~~> Resize the chart to match shapes picture. Notice that we are
    '~~> setting chart's width as the pictures `height` becuse even when
    '~~> the image is rotated, the Height and Width do not swap.
    With .Shapes(2)
        .Width = p.Height
        .Height = p.Width
    End With

    .Shapes(p.Name).Copy

    With ActiveChart
        .ChartArea.Select
        .Paste
    End With

    '~~> Temp path where we will save the pic
    NewPath = TempPath & "NewFile.Jpg"

    '~~> Export the image
    .ChartObjects(1).Chart.Export filename:=NewPath, FilterName:="jpg"
End With

'~~> Delete the temp sheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Sub

the problem (you can see PROBLEM in the code) is that I don't know how to get the path of the picture that is in image box (I upload the picture through a image dialog) How can I solve?

Solution

  • May simply try like this enter image description here

    Code:

    Private Sub CommandButton1_Click()
Me.Image1.Picture = LoadPicture("C:\users\user\desktop\Range.jpg")
End Sub

Sub test()
Dim Ws As Worksheet, fname As String
Dim Shp As ShapeRange, p As Object
Dim Chrt As Chart
fname = "C:\users\user\desktop\TempXXX.jpg"
Set Ws = ThisWorkbook.Sheets("Sheet1")
SavePicture Me.Image1.Picture, fname
DoEvents
Set p = Ws.Pictures.Insert(fname)
p.ShapeRange.Rotation = 90

    Ws.Shapes(p.Name).Copy
    Set Chrt = Ws.ChartObjects.Add(10, 10, Ws.Shapes(p.Name).Height, Ws.Shapes(p.Name).Width).Chart
    Chrt.Paste

Chrt.Export Filename:=fname, FilterName:="jpg"
DoEvents
Me.Image1.Picture = LoadPicture(fname)
'clean temp objects
 Kill fname
 p.Delete
 Chrt.Parent.Delete
End Sub

Private Sub CommandButton2_Click()
test
End Sub