WORD批量调整图片尺寸

Tobin_Zhang

以下是本人录制的一个WORD宏：  调整图片尺寸，并删除.JPG，如何修改才能满足以下要求：   调整鼠标之后的图片尺寸为2.55*3.39inch，删除鼠标之后的  .JPG，并保持鼠标停留在原位不变 （注： 鼠标后的所有内容均未选择）。请高手帮助修改一下，谢谢！

Sub Adjust_ImageSize()
'
' Adjust_ImageSize Macro
'
'
Dim i As Integer
For i = 2 To ActiveDocument.InlineShapes.Count
With ActiveDocument.InlineShapes(i)
.Height = 2.55 * 2.54 * 28.35
.Width = 3.39 * 2.54 * 28.35
.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderTop).LineWidth = wdLineWidth050pt
.Borders(wdBorderTop).Color = wdColorAutomatic
End With
Next i
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ".JPG"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   

End Sub

wdpfox

                        

sylun

可试试如下修改：

1. Sub Adjust_ImageSize2()
   
2.     '只处理插入点后部分，只针对嵌入式图片
   
3.     Dim myInlineshape As InlineShape
   
4.     Dim i As Integer
   
5.    
   
6.     Application.ScreenUpdating = False
   
7.     With ActiveDocument.Range(Selection.Start, ActiveDocument.Content.End)
   
8.         For Each myInlineshape In .InlineShapes
   
9.             i = i + 1
   
10.             With myInlineshape
    
11.                 .LockAspectRatio = msoFalse
    
12.                 .Height = InchesToPoints(2.55)
    
13.                 .Width = InchesToPoints(3.39)
    
14.             End With
    
15.         Next
    
16.         With .Find
    
17.             .ClearFormatting
    
18.             .Text = ".jpg"
    
19.             .MatchCase = False
    
20.             .Replacement.Text = ""
    
21.             .Execute Replace:=wdReplaceAll
    
22.         End With
    
23.     End With
    
24.     MsgBox "共处理了" & i & "个嵌入式图片。", vbInformation
    
25.     Application.ScreenUpdating = True
    
26. End Sub

复制代码

Tobin_Zhang

sylun 发表于 2019-6-22 13:15
可试试如下修改：

非常感谢您，太给力啦！

Tobin_Zhang

sylun 发表于 2019-6-22 13:15
可试试如下修改：

您好，非常感谢您的帮助，非常实用，但在实际中，我有时候用手机拍照，尽管照片旋转成了水平，但是照片属性  heigh 大于width, 以致于插入WORD的图片批量调整尺寸后变形，您能帮助我修改一下宏代码么？


链接如下，请高手赐教，谢谢！
http://club.excelhome.net/thread-1485983-1-1.html

sylun

Tobin_Zhang 发表于 2019-6-29 22:11
您好，非常感谢您的帮助，非常实用，但在实际中，我有时候用手机拍照，尽管照片旋转成了水平，但是照片属 ...

原代码是针对图片高宽分别设置的，也就是不锁定纵横比的。如要锁定，可将.LockAspectRatio = msoFalse改为.LockAspectRatio = msoTrue，并只保留宽度或高度值一行即可。

Tobin_Zhang

sylun 发表于 2019-6-30 20:52
原代码是针对图片高宽分别设置的，也就是不锁定纵横比的。如要锁定，可将.LockAspectRatio = msoFalse改 ...

谢谢您的解答！

但是锁定横纵比以后，图片大小将不一样 ，例如图A=4inch/3inch， 图B=3inch/4inch，锁定比例后，如果height=3inch， 那么图B的width=2.25inch，图片就不一样大啦！我也不知道为什么，用手机横着拍照，拍出来的图片有的横着，有的竖着...另外，该如何设置图片在表格中的位置，期待您的答复，谢谢！

Tobin_Zhang

sylun 发表于 2019-6-22 13:15
可试试如下修改：

您好，老师，我发现这个查找替换，替换的是文档中所有的  .JPG，而不是鼠标所在位置到文档末尾的 .JPG  


  With ActiveDocument.Range(Selection.Start, ActiveDocument.Content.End)
        With .Find
            .ClearFormatting
            .Text = ".jpg"
            .MatchCase = False
            .Replacement.Text = ""
            .Execute Replace:=wdReplaceAll
        End With
    End With