注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

Mr.Right

不顾一切的去想,于是我们有了梦想。脚踏实地的去做,于是梦想成了现实。

 
 
 

日志

 
 
关于我

人生一年又一年,只要每年都有所积累,有所成长,都有那么一次自己认为满意的花开时刻就好。即使一时不顺,也要敞开胸怀。生命的荣枯并不是简单的重复,一时的得失不是成败的尺度。花开不是荣耀,而是一个美丽的结束,花谢也不是耻辱,而是一个低调的开始。

网易考拉推荐

VBA批量缩小Word中图片  

2013-10-10 22:55:39|  分类: 编程 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
给老师处理数据后需要给word中贴的图简直是太多了。在网上找了下前人的经验,自己亲自验证了下。VBA还是蛮爽的。希望对需要的人有所帮助。下面的代码分两个步骤进行

(1) 在word文档中Alt + F11 打开 VBA编辑器,在ThisDocument上右键,插入模块,黏贴如下代码到“模块”里。
 (2)在word文档中Alt + F8 打开宏列表,点击运行按钮执行不同的宏代码!

VBA批量缩小Word中图片 - 阿英 - Mr.Right
 

'1) Shape 表示对象在绘图层中,如自选图形、 任意多边形、 OLE 对象、 ActiveX 控件或图片。
' Shape对象可以自由浮动,并可放置在页面上的任何位置。InlineShape对象视为字符,并定位为一行文本中的字符。
'InlineShape 代表文档中的嵌入式图形对象。
'2) Shape 与 InlineShape 对象在文档中分别属于 Shapes 集合与 InlineShapes 集合。
'通过 Shape 对象的 ConvertToInlineShape 方法可以将 Shape 对象转换为 InlineShape 对象。
'通过 InlineShape 对象的 ConvertToShape 方法可将 InlineShape 对象转换为 Shape 对象。

Sub ConvertInlineShape2Shape()
For Each iShape In ActiveDocument.InlineShapes
    iShape.ConvertToShape
Next iShape

End Sub

' 看看 for each 处理集合元素很方便
Sub ConvertShape2InlineShape()
For Each iShape In ActiveDocument.Shapes
    iShape.ConvertToInlineShape
Next iShape
End Sub

Sub checkDocOpen()
If Application.Documents.Count >= 1 Then
    MsgBox ActiveDocument.Name
Else
    MsgBox "No documents are open"
End If
End Sub


'vba批量修改Word中图片大小
'需要注意的地方 就是注意厘米与像素的换算关系。一般情况下1厘米=28px

Sub ResetPicsSizes()
Dim n As Integer '图片个数
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
    ActiveDocument.InlineShapes(n).Height = 300 '设置图片高度为 300px
    ActiveDocument.InlineShapes(n).Width = 200 '设置图片宽度 200px
Next n

For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
    ActiveDocument.Shapes(n).Height = 300 '设置图片高度为 300px
    ActiveDocument.Shapes(n).Width = 200 '设置图片宽度 200px
Next n
End Sub


Sub setPicSize_A4() '批量缩放Word图片 把所有图片按原高宽比缩放到A4纸的工作宽度大小(小图片也会被放大)

'如果不需要处理小图片,可以加 If 判断,只处理所有宽度大于420的图片即可


    Dim n As Integer '图片个数
    Dim picwidth    '图片宽度
    Dim picheight   '图片高度
    On Error Resume Next '忽略错误
    For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
        picheight = ActiveDocument.InlineShapes(n).Height   '获取图片高度(像素值)
        picwidth = ActiveDocument.InlineShapes(n).Width     '获取图片宽度(像素值)
        
        '设置宽度适合文档大小
        '(420/picwidth)为缩放比例
        '其中,420为Word中A4纸默认工作宽度(估计值。。。)
        ActiveDocument.InlineShapes(n).Width = picwidth * (420 / picwidth)   '缩放宽度
        ActiveDocument.InlineShapes(n).Height = picheight * (420 / picwidth) '同比例缩放高度
        
    Next n
    
    For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
        picheight = ActiveDocument.Shapes(n).Height
        picwidth = ActiveDocument.Shapes(n).Width
        
        ActiveDocument.Shapes(n).Width = picwidth * (420 / picwidth)   '同上
        ActiveDocument.Shapes(n).Height = picheight * (420 / picwidth) '同上
        
    Next n
End Sub

  评论这张
 
阅读(1073)| 评论(2)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2016