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

分手后的思念是犯贱 2022-05-19 02:29 297阅读 0赞

前言：

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

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

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

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

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

按插入

![1082376-20170414114818470-1272316310.png][]

按图片

![1082376-20170414114905876-826999896.png][]

看一下下方的文件名

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

![1082376-20170414220917876-1147355244.png][]

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

![1082376-20170414221400111-249984412.png][]

效果：

![1082376-20170414115044173-1136439405.png][]

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

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

![1082376-20170414123538830-476951814.png][]

或插入图片：

原来的word为:

![1082376-20170415124752939-300096195.png][]

按视图

![1082376-20170414123110876-1172454253.png][]

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

![1082376-20170414122223220-515792613.png][]

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

Sub setpicsize()
        Dim i
        Dim Height, Weight
        Height = 300
        Weight = 200
        
        On Error Resume Next '忽略错误
        For i = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
                ActiveDocument.InlineShapes(i).Height = Height '设置图片高度为 Height_px
                ActiveDocument.InlineShapes(i).Width = Weight '设置图片宽度 Weight_px
        Next i
    
        For i = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
                ActiveDocument.Shapes(i).Height = Height '设置图片高度为 Height_px
                ActiveDocument.Shapes(i).Width = Weight '设置图片宽度 Weight_px
        Next i
    End Sub

![1082376-20170415105930939-641205746.jpg][]

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

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

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

效果：

![1082376-20170415105649970-1400707749.jpg][]

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

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

![1082376-20170414123830220-1673011720.png][]

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

![1082376-20170414123920392-1169272506.png][]

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

程序1：

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

Sub GetPhotoSize()
        Dim str As String
        Dim i
        
        For i = 1 To ActiveDocument.InlineShapes.Count
            'cstr:数字转字符串
            str = str + CStr(i) + ": "
            str = str + CStr(ActiveDocument.InlineShapes(i).Height) + " "
            str = str + CStr(ActiveDocument.InlineShapes(i).Width) + " "
            'chr(13)代表换行
            str = str + Chr(13)
        Next i
        MsgBox str
    End Sub

效果：

![1082376-20170415122906751-1395901036.png][]

程序2：

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

Sub ModifyPhoto1()
        Dim i, x, y
        Dim Height, Weight
        Height = 80
        Weight = 100
        '修改第x张图片到第y张图片的大小
        x = 4
        y = 13
        On Error Resume Next '忽略错误
        For i = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
            If i >= x And i <= y Then
                ActiveDocument.InlineShapes(i).Height = Height '设置图片高度为 Height_px
                ActiveDocument.InlineShapes(i).Width = Weight '设置图片宽度 Weight_px
            End If
        Next i
    
        For i = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
            If i > k Then
                ActiveDocument.Shapes(i).Height = Height '设置图片高度为 Height_px
                ActiveDocument.Shapes(i).Width = Weight '设置图片宽度 Weight_px
            End If
        Next i
    End Sub

效果：

![1082376-20170415110410626-497699554.png][]

程序3：

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

Sub ModifyPhoto2()
        '修改某一些图片的大小为某个值，修改另一些图片的大小为另外一个值
        Dim i, ans
        '100为图片最大数量，可以修改
        Dim vis(1 To 100) As Boolean
        Dim Height1, Weight1
        Dim Height2, Weight2
        Height1 = 80
        Weight1 = 100
        Height2 = 150
        Weight2 = 200
    
        On Error Resume Next '忽略错误
        For i = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
            vis(i) = False
        Next i
        'x(k)=true means modify the k_th photo
        For i = 4 To 13
            vis(i) = False
        Next i
        For i = 15 To 23
            vis(i) = False
        Next i
        
        For i = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
            If vis(i) = True Then
                ActiveDocument.InlineShapes(i).Height = Height1 '设置图片高度为 Height_px
                ActiveDocument.InlineShapes(i).Width = Weight1 '设置图片宽度 Weight_px
            Else
                ActiveDocument.InlineShapes(i).Height = Height2 '设置图片高度为 Height_px
                ActiveDocument.InlineShapes(i).Width = Weight2 '设置图片宽度 Weight_px
            End If
        Next i
    End Sub

效果：

![1082376-20170415111033986-1959117230.png][]

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

效果：

![1082376-20170415123558158-1515944734.png][]

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

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

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

![1082376-20170415125016064-178349755.png][]

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

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

效果：

![1082376-20170415132011673-2134972728.jpg][]

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

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

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

以下是**错误**程序：

'With Selection.Find
        '    .Text = True
        '    .Replacement.Text = ""
        '    .Wrap = wdFindContinue
        'End With
        'Selection.Find.Execute Replace:=wdReplaceAll
    
    
        'Dim ch As Range
        'For Each ch In ActiveDocument.Words
        '    ch.Delete
        'Next

效果：

![1082376-20170415221231751-1610018359.png][]

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

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

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

Sub ModifyCharacter()
        Dim str As String
        str = "图片"
        With Selection.Find
            .Text = str
            .Replacement.Font.Bold = True
            .Replacement.Font.Color = wdColorRed
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    End Sub

之前

![1082376-20170415235328314-1134161852.jpg][]

现在：

![1082376-20170415235257830-1963803256.jpg][]

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

附录：自己写的一个设计；word中一个图片高度，宽度按照原有尺寸自动变形。

Sub setpicsize()
        Dim str As String
        Dim i
        
        Dim Height, Weight, ratio
        Height = 50   '设定图片的高度  px
        
        
        For i = 1 To ActiveDocument.InlineShapes.Count
            'cstr:数字转字符串
            Weight = ActiveDocument.InlineShapes(i).Width
            ratio = ActiveDocument.InlineShapes(i).Height / ActiveDocument.InlineShapes(i).Width
           
            ActiveDocument.InlineShapes(i).Height = Height '设置图片高度为 Height_px
            ActiveDocument.InlineShapes(i).Width = Weight / ratio '设置图片宽度 Weight_px
        Next i
        
        For i = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
            Weight = ActiveDocument.Shapes(i).Width
            ratio = ActiveDocument.Shapes(i).Height / ActiveDocument.InlineShapes(i).Width
           
            ActiveDocument.Shapes(i).Height = Height '设置图片高度为 Height_px
            ActiveDocument.Shapes(i).Width = Weight / ratio '设置图片宽度 Weight_px
               
        Next i
    End Sub

[1082376-20170414114818470-1272316310.png]: /images/20220519/b3fa0eb146414a3bbd3ea9c44e52959d.png
[1082376-20170414114905876-826999896.png]: /images/20220519/220bbe5751eb41afb578bc2707eacf5d.png
[1082376-20170414220917876-1147355244.png]: /images/20220519/f6597bf9586b48f1a4f66c792fb3ab91.png
[1082376-20170414221400111-249984412.png]: /images/20220519/23eacf913cc44d6e8ddbeca5e6d44f57.png
[1082376-20170414115044173-1136439405.png]: /images/20220519/942775a918e348e1ab92f46e1b38cb3c.png
[1082376-20170414123538830-476951814.png]: /images/20220519/88dd3b40ec874fbb9aa418a9c7640fc9.png
[1082376-20170415124752939-300096195.png]: /images/20220519/a23bbae056ad49678e2ceaae85fa6c02.png
[1082376-20170414123110876-1172454253.png]: /images/20220519/2a2f557da48542b9bf8a3671f28634e1.png
[1082376-20170414122223220-515792613.png]: /images/20220519/8b174d6e3362403f840f12da49abb757.png
[1082376-20170415105930939-641205746.jpg]: /images/20220519/ccd660816215438088db347cf29de1e8.png
[1082376-20170415105649970-1400707749.jpg]: /images/20220519/61084beff87646be8bc2de00b1a13d12.png
[1082376-20170414123830220-1673011720.png]: /images/20220519/b0d2841f5ed84d81b3de59d74a98a56a.png
[1082376-20170414123920392-1169272506.png]: /images/20220519/330da33ea6384691b2073af6054f237f.png
[1082376-20170415122906751-1395901036.png]: /images/20220519/ce899cbfd480452da50067f78ea475a6.png
[1082376-20170415110410626-497699554.png]: /images/20220519/950de164f6a14dbcaec6d2b4243825b8.png
[1082376-20170415111033986-1959117230.png]: /images/20220519/ee1dbbba6d9b40a2adf19833f476cace.png
[1082376-20170415123558158-1515944734.png]: /images/20220519/dfdf6b278f034d0e880acc2e8ca40ce0.png
[1082376-20170415125016064-178349755.png]: /images/20220519/29540cd5b9d041cf9fa989f1a04f784c.png
[1082376-20170415132011673-2134972728.jpg]: /images/20220519/53ee9e55db4141d099a26b52b44aa56f.png
[1082376-20170415221231751-1610018359.png]: /images/20220519/6e7a975c75ec429a884a4018c71de0d6.png
[1082376-20170415235328314-1134161852.jpg]: /images/20220519/0788ffc9b05d4bfaa32abaea34187a21.png
[1082376-20170415235257830-1963803256.jpg]: /images/20220519/8db9bfa0f1144b8ab99cfd6dc659bb78.png