word中批量修改图片大小的两个方法

前言：

对于把ppt的内容拷贝到word中：

对ppt的一页进行复制，然后粘贴到word中

如果要的是ppt运行过程中的内容，在qq运行的情况下，按Ctrl+Alt+A截屏，按勾，然后可以直接粘贴到word中(生成的图片已经在剪贴板中了)

////////////////////////////////////////////////////////////////////////////////////////////////////

1.图片只需要符合文档大小即可

方法：插入图片，word自动处理图片大小。

按插入

按图片

看一下下方的文件名

按Ctrl+A(全选)，图片的顺序按照电脑文件的顺序排列的

每一次按Ctrl+点击图片，被点击的图片放在首位

效果：

////////////////////////////////////////////////////////////////////////////////////////////////////

2.图片需要修改为具体的大小

把图片复制，直接在word中粘贴，图片以原始大小显示

////////////////////////////////////////////////////////////////////////////////////////////////////

或插入图片：

原来的word为:

////////////////////////////////////////////////////////////////////////////////////////////////////

按视图

按宏，查看宏，输入setpicsize，按创建

复制并粘贴以下程序并按调试+编译，看看程序有没有错误

 1 Sub setpicsize()
 2     Dim i
 3     Dim Height, Weight
 4     Height = 300
 5     Weight = 200
 6     
 7     On Error Resume Next '忽略错误
 8     For i = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
 9             ActiveDocument.InlineShapes(i).Height = Height '设置图片高度为 Height_px
10             ActiveDocument.InlineShapes(i).Width = Weight '设置图片宽度 Weight_px
11     Next i
12 
13     For i = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
14             ActiveDocument.Shapes(i).Height = Height '设置图片高度为 Height_px
15             ActiveDocument.Shapes(i).Width = Weight '设置图片宽度 Weight_px
16     Next i
17 End Sub
18 (来自网络程序修改)

如果没有错误，保存(Ctrl+S)并退出(Alt+F4)

然后按宏，查看宏，选择名字为setpicsize的宏，并按运行，稍等片刻即可完成

或者直接在代码页面按运行+运行子过程(F5)

效果：

如果下一次要修改图片的大小时，

按宏，查看宏，选择名字为setpicsize的宏，并按编辑

修改图片大小，如高度为100，宽度为50，修改Height和Weight的值即可

然后编译，保存，退出，运行这个宏即可

////////////////////////////////////////////////////////////////////////////////////////////////////

程序1：

查看每张图片的大小，方便后续的修改

 1 Sub GetPhotoSize()
 2     Dim str As String
 3     Dim i
 4     
 5     For i = 1 To ActiveDocument.InlineShapes.Count
 6         'cstr:数字转字符串
 7         str = str + CStr(i) + ": "
 8         str = str + CStr(ActiveDocument.InlineShapes(i).Height) + " "
 9         str = str + CStr(ActiveDocument.InlineShapes(i).Width) + " "
10         'chr(13)代表换行
11         str = str + Chr(13)
12     Next i
13     MsgBox str
14 End Sub

效果：

////////////////////////////////////////////////////////////////////////////////////////////////////

程序2：

修改第x张图片到第y张图片的大小(可以分成很多段)

 1 Sub ModifyPhoto1()
 2     Dim i, x, y
 3     Dim Height, Weight
 4     Height = 80
 5     Weight = 100
 6     '修改第x张图片到第y张图片的大小
 7     x = 4
 8     y = 13
 9     On Error Resume Next '忽略错误
10     For i = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
11         If i >= x And i <= y Then
12             ActiveDocument.InlineShapes(i).Height = Height '设置图片高度为 Height_px
13             ActiveDocument.InlineShapes(i).Width = Weight '设置图片宽度 Weight_px
14         End If
15     Next i
16 
17     For i = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
18         If i > k Then
19             ActiveDocument.Shapes(i).Height = Height '设置图片高度为 Height_px
20             ActiveDocument.Shapes(i).Width = Weight '设置图片宽度 Weight_px
21         End If
22     Next i
23 End Sub

效果：

////////////////////////////////////////////////////////////////////////////////////////////////////

程序3：

修改某一些图片的大小为某个值，修改另一些图片的大小为另外一个值(可以分成很多段，用boolean)

 1 Sub ModifyPhoto2()
 2     '修改某一些图片的大小为某个值，修改另一些图片的大小为另外一个值
 3     Dim i, ans
 4     '100为图片最大数量，可以修改
 5     Dim vis(1 To 100) As Boolean
 6     Dim Height1, Weight1
 7     Dim Height2, Weight2
 8     Height1 = 80
 9     Weight1 = 100
10     Height2 = 150
11     Weight2 = 200
12 
13     On Error Resume Next '忽略错误
14     For i = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
15         vis(i) = False
16     Next i
17     'x(k)=true means modify the k_th photo
18     For i = 4 To 13
19         vis(i) = False
20     Next i
21     For i = 15 To 23
22         vis(i) = False
23     Next i
24     
25     For i = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
26         If vis(i) = True Then
27             ActiveDocument.InlineShapes(i).Height = Height1 '设置图片高度为 Height_px
28             ActiveDocument.InlineShapes(i).Width = Weight1 '设置图片宽度 Weight_px
29         Else
30             ActiveDocument.InlineShapes(i).Height = Height2 '设置图片高度为 Height_px
31             ActiveDocument.InlineShapes(i).Width = Weight2 '设置图片宽度 Weight_px
32         End If
33     Next i
34 End Sub

效果：

////////////////////////////////////////////////////////////////////////////////////////////////////

程序4：当图片大小大于(或小于)某个值时，修改为另外一个值。

效果：

////////////////////////////////////////////////////////////////////////////////////////////////////

程序5：删去所有的图片，只剩下文字

 1 Sub DeletePhoto()
 2     On Error Resume Next '忽略错误
 3     '两个for循环不能用同一个变量
 4     '因为photo1指的是所有在ActiveDocument.InlineShapes的元素
 5     '因为photo2指的是所有在ActiveDocument.Shapes的元素，二者被定义后不可改变
 6     Dim photo1, photo2 As Range
 7     For Each photo1 In ActiveDocument.InlineShapes
 8         photo1.Delete
 9     Next
10     For Each photo2 In ActiveDocument.Shapes
11         photo2.Delete
12     Next
13 End Sub

效果(有可能剩下一些换行符)：

////////////////////////////////////////////////////////////////////////////////////////////////////

程序6：在程序变通5只剩下文字的基础上，删去换行符

 1 Sub changeCharacter()
 2     With Selection.Find
 3         '原来的内容
 4         .Text = "^p"
 5         '要修改成的内容，如果为""相当于删除
 6         .Replacement.Text = ""
 7         'wrap() 方法把每个被选元素放置在指定的内容或元素中。规定包裹(wrap)被选元素的内容。
 8         .Wrap = wdFindContinue
 9     End With
10     '进行修改操作
11     Selection.Find.Execute Replace:=wdReplaceAll
12 End Sub

效果：

(也可以做 1个换行变成2个换行的操作，使文档看起来更舒服：.Text="^p"　　.Replacement.Text="^p"）

////////////////////////////////////////////////////////////////////////////////////////////////////

程序变通7：删去所有的文字，只剩下图片

 1 Sub DeleteCharacter()
 2     Dim word As Range
 3     For Each word In ActiveDocument.Words
 4         'NoProofing:如此如果拼写和语法检查程序忽略指定的文本。如果仅有某些指定的文本将NoProofing属性设置为True ，则返回wdUndefined 。读/写长。
 5         '图片值为-1，文字值为0
 6         If word.NoProofing = 0 Then
 7             word.Delete
 8         End If
 9     Next word
10 End Sub

以下是错误程序：

 1     'With Selection.Find
 2     '    .Text = True
 3     '    .Replacement.Text = ""
 4     '    .Wrap = wdFindContinue
 5     'End With
 6     'Selection.Find.Execute Replace:=wdReplaceAll
 7 
 8 
 9     'Dim ch As Range
10     'For Each ch In ActiveDocument.Words
11     '    ch.Delete
12     'Next

效果：

////////////////////////////////////////////////////////////////////////////////////////////////////

程序8：第x张图片到第y张图片改变顺序，变成第y张图片(原来)到第x张图片(原来)

////////////////////////////////////////////////////////////////////////////////////////////////////

程序9：把所有的图片保存在一个文件夹下，或转移图片到另外一个word文档

////////////////////////////////////////////////////////////////////////////////////////////////////

程序10：把某些字加粗和改变颜色

 1 Sub ModifyCharacter()
 2     Dim str As String
 3     str = "图片"
 4     With Selection.Find
 5         .Text = str
 6         .Replacement.Font.Bold = True
 7         .Replacement.Font.Color = wdColorRed
 8     End With
 9     Selection.Find.Execute Replace:=wdReplaceAll
10 End Sub

之前

现在：

 1 附: Word通配符查找详解（Wildcards）  
 2 
 3 通配符使用规则如下：  
 4 任意单个字符 键入 ?  
 5 例如，s?t 可查找“sat”和“set”。  
 6 
 7 任意字符串 键入 *  
 8 例如，s*d 可查找“sad”和“started”。  
 9 
10 单词的开头 键入< 
11 例如，<(inter) 查找“interesting”和“intercept”，但不查找“splintered”。  
12 
13 单词的结尾 键入> 
14 例如，(in)>查找“in”和“within”，但不查找“interesting”。  
15 
16 指定字符之一 键入 [ ]  
17 例如，w[io]n 查找“win”和“won”。  
18 
19 指定范围内任意单个字符 键入 [-]  
20 例如，[r-t]ight 查找“right”和“sight”。必须用升序来表示该范围。  
21 
22 中括号内指定字符范围以外的任意单个字符 键入 [!x-z]  
23 例如，t[!a-m]ck 查找“tock”和“tuck”，但不查找“tack”和“tick”。  
24 
25 n 个重复的前一字符或表达式 键入 {n}  
26 例如，fe{2}d 查找“feed”，但不查找“fed”。  
27 
28 至少 n 个前一字符或表达式 键入 {n,}  
29 例如，fe{1,}d 查找“fed”和“feed”。  
30 
31 n 到 m 个前一字符或表达式 键入 {n,m}  
32 例如，10{1,3} 查找“10”、“100”和“1000”。
33   
34 一个以上的前一字符或表达式 键入 @  
35 例如，lo@t 查找“lot”和“loot”。  
36 
37 特殊意义的字符 键入   
38 例如，f[?]t 查找“f?t”   ( ) 
39 对查询结果没有影响，是一个替换时分组的概念 例子： 
40 用2 1替换(John) (Smith)，得到结果Smith John  即1代表John，2代表Smith 
(来自网络)