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
(来自网络)
