批量设置图片大小方法

珏山居士

方法一：

这部分是要把word中的所有图片修改成固定的并且相同的长和宽！

1、打开word，工具－宏－宏（或者直接按Alt+F8）进入宏的界面，如下面所示，输入一个宏名，宏名自己起，能记住就行！

2、宏名起好了，单击“创建”进入VisualBasic编辑器，输入如下代码并保存Subsetpicsize()'设置图片大小Dimn'图片个数

OnErrorResumeNext'忽略错误

Forn=1ToActiveDocument.InlineShapes.Count'InlineShapes类型图片ActiveDocument.InlineShapes(n).Height=400'设置图片高度为400pxActiveDocument.InlineShapes(n).Width=300'设置图片宽度300pxNextn

Forn=1ToActiveDocument.Shapes.Count'Shapes类型图片ActiveDocument.Shapes(n).Height=400'设置图片高度为400pxActiveDocument.Shapes(n).Width=300'设置图片宽度300pxNextnEndSub

3、返回word，工具－宏－宏（或者直接按Alt+F8），再次进入宏的界面，选择刚才编辑好的宏，并单击“运行”按钮，就可以了！（图片多时，可能会花一些时间）

方法二：

1、在word中按alt+f11组合键,进入VBA模式

2、在左边的工程资源管理器中找到你的word文档,在其上右键/添加/模块3、把下面代码复制,粘贴进去.

4、更改数值,改一下宽度和高度数值(10)，点运行(类似播放按钮.)或f5,即可设置文档中全部图片SubMacro()

Mywidth=10„10为图片宽度（厘米）Myheigth=10„10为图片高度（厘米）

ForEachiShapeInActiveDocument.InlineShapesiShape.Height=28.345*MyheigthiShape.Width=28.345*MywidthNextiShapeEndSub

word批量修改图片大小——按比例缩放篇

这部分要说的是把word中的所有图片按比例缩放！具体操作同上，只是代码部分稍做修改，代码如下：Subsetpicsize()'设置图片大小Dimn'图片个数Dimpicwidth

Dimpicheight

OnErrorResumeNext'忽略错误

Forn=1ToActiveDocument.InlineShapes.Count'InlineShapes类型图片picheight=ActiveDocument.InlineShapes(n).Heightpicwidth=ActiveDocument.InlineShapes(n).Width

ActiveDocument.InlineShapes(n).Height=picheight*1.1'设置高度为1.1倍ActiveDocument.InlineShapes(n).Width=picwidth*1.1'设置宽度为1.1倍Nextn

Forn=1ToActiveDocument.Shapes.Count'Shapes类型图片picheight=ActiveDocument.Shapes(n).Heightpicwidth=ActiveDocument.Shapes(n).Width

ActiveDocument.Shapes(n).Height=picheight*1.1'设置高度为1.1倍ActiveDocument.Shapes(n).Width=picwidth*1.1'设置宽度为1.1倍NextnEndSub

该贴已经同步到 珏山居士的微博

wudixin96

排版改下啊，连成一块了

肖表哥

真得学习一下排版再发。

lcdopod

留个记号回家看，正好用得到

banjinjiu

楼主代码：

1. Sub setpicsize1() '设置图片大小
   
2. Dim n '图片个数
   
3. On Error Resume Next '忽略错误
   
4. For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
   
5. ActiveDocument.InlineShapes(n).Height = 400 '设置图片高度为400px
   
6. ActiveDocument.InlineShapes(n).Width = 300 '设置图片宽度300px
   
7. Next n
   
8. For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
   
9. ActiveDocument.Shapes(n).Height = 400 '设置图片高度为400px
   
10. ActiveDocument.Shapes(n).Width = 300 '设置图片宽度300px
    
11. Next n
    
12. End Sub

复制代码

1. Sub Macro()
   
2. Mywidth = 10 '10为图片宽度（厘米）
   
3. Myheigth = 10 '10为图片高度（厘米）
   
4. For Each iShape In ActiveDocument.InlineShapes
   
5. iShape.Height = 28.345 * Myheigth
   
6. iShape.Width = 28.345 * Mywidth
   
7. Next iShape
   
8. End Sub

复制代码

1. Sub setpicsize2() '设置图片大小
   
2. Dim n '图片个数
   
3. Dim picwidth
   
4. Dim picheight
   
5. On Error Resume Next '忽略错误
   
6. For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
   
7. picheight = ActiveDocument.InlineShapes(n).Height
   
8. picwidth = ActiveDocument.InlineShapes(n).Width
   
9. ActiveDocument.InlineShapes(n).Height = picheight * 1.1 '设置高度为1.1倍
   
10. ActiveDocument.InlineShapes(n).Width = picwidth * 1.1 '设置宽度为1.1倍
    
11. Next n
    
12. For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
    
13. picheight = ActiveDocument.Shapes(n).Height
    
14. picwidth = ActiveDocument.Shapes(n).Width
    
15. ActiveDocument.Shapes(n).Height = picheight * 1.1 '设置高度为1.1倍
    
16. ActiveDocument.Shapes(n).Width = picwidth * 1.1 '设置宽度为1.1倍
    
17. Next n
    
18. End Sub

复制代码

楼主的排版太万难，代码的效果也不敢恭维，照片严重变形，应该按照压缩比百分比，有时间修改下。

oylw

VBA好复杂！