使用vba旋转保存的图像

 雷子的世界6888 发布于 2023-02-05 10:09

我目前在excel中有一个userform,上面显示了图像(保存在临时文件夹"C:\ Temp\Photos"中)

我想要做的是有按钮(90,180,270)旋转位于"C:\ Temp\Photos"的图像.认为它可能是一个FileSystemObject,但还不知道他们还不知道如何做到这一点.

谢谢

编辑:按要求添加了一些代码.根据在组合框中选择的值插入图片.任何更改都会引用pic1-pic5(任何时候只有5个图片).

Private Sub ComboBox1_Change()
pic1 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\1.jpg"
pic2 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\2.jpg"
pic3 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\3.jpg"
pic4 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\4.jpg"
pic5 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\5.jpg"
If Dir(pic1) <> vbNullString Then
Me.Image1.Picture = LoadPicture(pic1)
Else
Me.Image1.Picture = LoadPicture("")
End If
If Dir(pic2) <> vbNullString Then
Me.Image2.Picture = LoadPicture(pic2)
Else
Me.Image2.Picture = LoadPicture("")
End If
If Dir(pic3) <> vbNullString Then
Me.Image3.Picture = LoadPicture(pic3)
Else
Me.Image3.Picture = LoadPicture("")
End If
If Dir(pic4) <> vbNullString Then
Me.Image4.Picture = LoadPicture(pic4)
Else
Me.Image4.Picture = LoadPicture("")
End If
If Dir(pic5) <> vbNullString Then
Me.Image5.Picture = LoadPicture(pic5)
Else
Me.Image5.Picture = LoadPicture("")
End If
End Sub

Siddharth Ro.. 10

就像我提到的,没有内置的方法来旋转用户窗体中的图片.话虽如此,还有另一种方法可以达到你想要的效果.下面我演示了如何将图像旋转90度.

逻辑:

    插入临时表

    将图像插入该表

    使用IncrementRotation旋转属性

    将图像导出到用户的临时目录

    删除临时表

    加载图像

准备你的表格

创建用户表单并插入图像控件和命令按钮.您的表单可能如下所示.图像控制的设置PictureSizeMode,以fmPictureSizeModeStretch在属性窗口.

在此输入图像描述

代码:

我写了一个RotatePic你可以通过学位的子课程.就像我提到的那样,这个例子会将它旋转90度,正如我刚才所展示的那样90.您可以为其余度数创建额外的按钮.我也对代码进行了评论,因此您不应该对它有任何问题.如果你这样做,那么只要问:)

Option Explicit

'~~> API to get the user's temp folder path
'~~> We will use this to store the rotated image
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

'~~> Load the image on userform startup
Private Sub UserForm_Initialize()
    Image1.Picture = LoadPicture("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
End Sub

'~~> Rotating the image 90 degs
Private Sub CommandButton1_Click()
    RotatePic 90

    DoEvents

    Image1.Picture = LoadPicture(NewPath)
End Sub

'~~> Rotating the image
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("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")

    '~~> 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

'~~> Get the user's temp path
Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

在行动中

运行用户窗体时,将上载图像,当您单击该按钮时,图像将被旋转!

在此输入图像描述

1 个回答
  • 就像我提到的,没有内置的方法来旋转用户窗体中的图片.话虽如此,还有另一种方法可以达到你想要的效果.下面我演示了如何将图像旋转90度.

    逻辑:

      插入临时表

      将图像插入该表

      使用IncrementRotation旋转属性

      将图像导出到用户的临时目录

      删除临时表

      加载图像

    准备你的表格

    创建用户表单并插入图像控件和命令按钮.您的表单可能如下所示.图像控制的设置PictureSizeMode,以fmPictureSizeModeStretch在属性窗口.

    在此输入图像描述

    代码:

    我写了一个RotatePic你可以通过学位的子课程.就像我提到的那样,这个例子会将它旋转90度,正如我刚才所展示的那样90.您可以为其余度数创建额外的按钮.我也对代码进行了评论,因此您不应该对它有任何问题.如果你这样做,那么只要问:)

    Option Explicit
    
    '~~> API to get the user's temp folder path
    '~~> We will use this to store the rotated image
    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
    
    '~~> Load the image on userform startup
    Private Sub UserForm_Initialize()
        Image1.Picture = LoadPicture("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
    End Sub
    
    '~~> Rotating the image 90 degs
    Private Sub CommandButton1_Click()
        RotatePic 90
    
        DoEvents
    
        Image1.Picture = LoadPicture(NewPath)
    End Sub
    
    '~~> Rotating the image
    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("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
    
        '~~> 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
    
    '~~> Get the user's temp path
    Function TempPath() As String
        TempPath = String$(MAX_PATH, Chr$(0))
        GetTempPath MAX_PATH, TempPath
        TempPath = Replace(TempPath, Chr$(0), "")
    End Function
    

    在行动中

    运行用户窗体时,将上载图像,当您单击该按钮时,图像将被旋转!

    在此输入图像描述

    2023-02-05 10:10 回答
撰写答案
今天,你开发时遇到什么问题呢?
立即提问
热门标签
PHP1.CN | 中国最专业的PHP中文社区 | PNG素材下载 | DevBox开发工具箱 | json解析格式化 |PHP资讯 | PHP教程 | 数据库技术 | 服务器技术 | 前端开发技术 | PHP框架 | 开发工具 | 在线工具
Copyright © 1998 - 2020 PHP1.CN. All Rights Reserved 京公网安备 11010802041100号 | 京ICP备19059560号-4 | PHP1.CN 第一PHP社区 版权所有