批量设置WORD文件图片大小

anijoe123

很多朋友都遇到要批量设置图片的问题，这个问题，只能通过VBA来实现。
在网上百度了很久，发现这方面VBA宏也不少，但功能都不灵活，操作不方便，一般有以下不足：
一、只能设置以磅的单位，不符合大家日常工作中以厘米为单位的操作习惯，一下子不知道设置多少磅；
二、图片纵横比锁定时，无法精确设置，比如要设置长6厘米，宽8厘米的图片，最后出来可能是6.01和8，或者7.9和6。
三、都必须在当前文档运行宏，每次要设置都要复制代码到另一个文档 ，不方便。

附件中宏解决了上述不足：
一、可以以厘米设置，长宽值随本人输入；
二、取消纵横比，可以正确设置图片大小；
三、可同时处理多个文档，不必将宏代码复制来复制去；




批量设置图片大小.rar (21.55 KB, 下载次数: 152)

2014-5-28 14:47 上传

点击文件名下载附件

闻启学

多谢分享  学习了

lcdopod

留名，最近正为这个事情犯愁呢，回家试试在来说体会

banjinjiu

楼主既然是来共享的，不是来炫耀的吧？设个密码做什么！
能否告诉密码，让我等也学习下？

etta945

丢人了，VBA是什么东东，我  我 我谷歌去下

banjinjiu

网上找的：

1. Private Sub CommandButton1_Click()
   
2. 'creat by 萧雨 260961242- 2014-05-28
   
3. Dim fd As FileDialog, vrtSelectedItem As Variant, wd As Document, p As InlineShape, w, h
   
4. Application.ScreenUpdating = False
   
5.     Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
6. With fd
   
7.     .AllowMultiSelect = True
   
8.     .InitialFileName = ActiveDocument.Path
   
9.     If .Show <> -1 Then
   
10.         Application.ScreenUpdating = True
    
11.         MsgBox "您没有选择任何文档！", vbOK, "退出"
    
12.         Exit Sub
    
13.     Else
    
14.     w = InputBox("输入要设置的图片宽度（cm）", "输入宽度", 8)
    
15.     h = InputBox("输入要设置的图片高度（cm）", "输入宽度", 8)
    
16.         For Each vrtSelectedItem In .SelectedItems
    
17.             Set wd = Documents.Open(vrtSelectedItem)
    
18.              For Each p In wd.InlineShapes
    
19.                 p.LockAspectRatio = msoFalse '取消锁定纵橫比
    
20.                  p.Width = Round(w / 2.54 * 72 * 4, 0) / 4 '将磅单位转化成厘米
    
21.                  p.Height = Round(h / 2.54 * 72 * 4, 0) / 4
    
22.              Next
    
23.             wd.Close savechanges:=True
    
24.             Set wd = Nothing
    
25.         Next
    
26.     End If
    
27. End With
    
28. Application.ScreenUpdating = True
    
29. MsgBox "图片设置完成！", , "运行完成   @萧260961242"
    
30. End Sub

复制代码

BOBBY北方笨猪

我不是想这样批量改图片，我是想图片插入到word中的时候自动改为我想要的尺寸，而原来的图片尺寸不做改变。可以实现么？

oylw

为什么要用宏呢？