在用户窗体中旋转图片

Question

我正在尝试在用户表单中旋转图像，这是我正在使用的方法：

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

问题（你可以在代码中看到问题）是我不知道如何获取图片框中图片的路径（我通过图片对话框上传图片）我该如何解决？

Answer 1

可能只是这样尝试

代码：

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

Answer 2

上述“.chart”方法是一种技巧。由于代码运行ning 比系统旋转大图像更快（这几乎是当今大多数手机和相机的标准），因此我花费了 12 个小时的调试时间。诸如生成的图像是空白图像，未更改的图像被加载回用户窗体等问题（因为代码已经运行在系统用旋转图像替换它之前插入指定目录中的图像. 没有多少 Wait, Sleep, DoEvents, 解决了这个问题. 恐怕它在单步执行时有效但对我来说不是实时的。解决方案是实施 Windows 图像采集 API。 Daniel Pineault 开发了一个整洁的 VBA 函数 here。这应该是首选解决方案。

在用户窗体中旋转图片

Rotate picture in user form

excel

vba

image

userform