使用Excel VBA调整并更改多张图片的格式 [英] Resize and change the format of multiple pictures using Excel VBA

问题描述

我有一个excel工作表与许多图片与各种尺寸和格式。我想使用excel VBA循环遍历工作表中的所有图片，并将每个图片设置为相同的宽度（214），并在调整大小后将图片类型更改为JPEG（以保持文件大小缩小）。我的照片位于各种单元格中，我不希望图片位置发生变化（即停留在同一个单元格中）。我是VBA的新手，尝试以下 - 但它不起作用。调试器停在我试图剪切图片的行。

  Sub Macro6（）
 
 Dim p As Object 
 
 Dim iCnt As Integer 
 
对于每个p在ActiveSheet.Shapes 
 p.Width = 217.44 
 p.Cut 
 p.PasteSpecial格式：=图片（JPEG），链接：= False 
 iCnt = iCnt + 1 
下一个p 
 End Sub 
  

解决方案

这不是Excel不喜欢的切割部分 - 这是粘贴部分。 粘贴和 PasteSpecial 是使用工作表对象（粘贴到其中）而不是图像调用的方法（你粘贴的东西）。我不知道你是否想缩小宽度并保持高度不变，或者如果要平均缩放两个尺寸。如果要平均缩放，请尝试：

  Sub Macro6（）
 Dim p As Object 
 
 Dim iCnt As Integer 
 Dim s As Double 
 Dim r As Range 
 
对于每个p在ActiveSheet.Shapes 
s = 214 / p.Width 
设置r = p.TopLeftCell 
 p.Width = 214 
 p.Height = p.Height * s 
 p.Cut 
 r.Select 
 ActiveSheet.PasteSpecial格式：=Picture（JPEG），链接：= False 
 Application.CutCopyMode = False 
 iCnt = iCnt + 1 
下一页p 
 End Sub 
  

如果您只是想缩小宽度并保持高度相同，请尝试：

  Sub Macro6（）
 Dim p As Object 
 
 Dim iCnt As Integer 
 Dim r作为范围
 
对于每个p在ActiveSheet.Shapes 
设置r = p.TopLeftCell 
 p.Width = 214 
 p.Cut 
 r.Select 
 ActiveSheet.PasteSpecial格式：=图片（JPEG），链接：= False 
 Application.CutCopyMode = False 
 iCnt = iCnt + 1 
下一页p 
 End Sub 
  

如果图片的位置原本位于单元格的拐角处，那么图片的位置应保持不变。否则，这将使图像的左上角与最近的单元格角对齐。 Application.CutCopyMode = False 是粘贴后的好习惯。它告诉Excel擦除剪贴板并返回正常操作，而不是等待您再次粘贴。希望这有帮助。

I have an excel worksheet with a lot of pictures with various sizes and formats. I want to use excel VBA to loop through all the pictures in the worksheet, and set each picture to the same width (214) and change the picture type to a JPEG after resizing (to keep the file size down). My pictures are located in various cells, and I don't want the picture locations to change (i.e. stay in the same cell). I'm new to VBA and tried the following - but it doesn't work. The debugger stops at the line where I'm trying to cut the picture.

Sub Macro6()

Dim p As Object

Dim iCnt As Integer

    For Each p In ActiveSheet.Shapes
        p.Width = 217.44
        p.Cut
        p.PasteSpecial Format:="Picture (JPEG)", Link:=False
        iCnt = iCnt + 1
    Next p
End Sub

解决方案

It's not the cutting part that Excel doesn't like--it's the pasting part. Paste and PasteSpecial are methods you call with a worksheet object (where you're pasting to) instead of the image (the thing you're pasting). I don't know if you want to just shrink the width and hold the height constant or if you want to scale both dimensions evenly. If you want to scale both evenly, try this:

Sub Macro6()
Dim p As Object

Dim iCnt As Integer
Dim s As Double
Dim r As Range

For Each p In ActiveSheet.Shapes
    s = 214 / p.Width
    Set r = p.TopLeftCell
    p.Width = 214
    p.Height = p.Height * s
    p.Cut
    r.Select
    ActiveSheet.PasteSpecial Format:="Picture (JPEG)", Link:=False
    Application.CutCopyMode = False
    iCnt = iCnt + 1
Next p
End Sub

If you're just trying to shrink the width and leave the height the same, try this:

Sub Macro6()
Dim p As Object

Dim iCnt As Integer
Dim r As Range

For Each p In ActiveSheet.Shapes
    Set r = p.TopLeftCell
    p.Width = 214
    p.Cut
    r.Select
    ActiveSheet.PasteSpecial Format:="Picture (JPEG)", Link:=False
    Application.CutCopyMode = False
    iCnt = iCnt + 1
Next p
End Sub

The locations of your pictures should stay exactly the same if they were originally right at the corner of a cell. Otherwise, this will align the top left corner of the image to the nearest cell corner. The Application.CutCopyMode = False is good practice after pasting. It tells Excel to wipe the clipboard and go back to normal operation instead of waiting for you to paste again. Hope this helps.

这篇关于使用Excel VBA调整并更改多张图片的格式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！