word中批量修改圖片大小的兩個方法

前言：

對於把ppt的內容拷貝到word中：

對ppt的一頁進行復制，然后粘貼到word中

如果要的是ppt運行過程中的內容，在qq運行的情況下，按Ctrl+Alt+A截屏，按勾，然后可以直接粘貼到word中(生成的圖片已經在剪貼板中了)

 

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

 

1.圖片只需要符合文檔大小即可

方法：插入圖片，word自動處理圖片大小。

 

按插入

 

按圖片

 

看一下下方的文件名

按Ctrl+A(全選)，圖片的順序按照電腦文件的順序排列的

 

每一次按Ctrl+點擊圖片，被點擊的圖片放在首位

 

 

效果：

 

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

 

2.圖片需要修改為具體的大小

 

把圖片復制，直接在word中粘貼，圖片以原始大小顯示

 

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

或插入圖片：

原來的word為: 

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

按視圖

 

按宏，查看宏，輸入setpicsize，按創建

 

復制並粘貼以下程序 並按調試+編譯，看看程序有沒有錯誤

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
(來自網絡程序修改)

 

如果沒有錯誤，保存(Ctrl+S)並退出(Alt+F4)

然后按宏，查看宏，選擇名字為setpicsize的宏，並按運行，稍等片刻即可完成

 

或者直接在代碼頁面按運行+運行子過程(F5)

效果：

 

如果下一次要修改圖片的大小時，

按宏，查看宏，選擇名字為setpicsize的宏，並按編輯

 

修改圖片大小，如高度為100，寬度為50，修改Height和Weight的值即可

然后編譯，保存，退出，運行這個宏即可

 

 

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

 

 

程序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

效果：

 

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

 

程序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

 

效果：

 

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

 

程序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

 

效果：

 

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

程序4：當圖片大小大於(或小於)某個值時，修改為另外一個值。

效果：

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

 程序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

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

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

 程序6：在程序變通5只剩下文字的基礎上，刪去換行符

 

Sub changeCharacter()
    With Selection.Find
        '原來的內容
        .Text = "^p"
        '要修改成的內容，如果為""相當於刪除
        .Replacement.Text = ""
        'wrap() 方法把每個被選元素放置在指定的內容或元素中。規定包裹(wrap)被選元素的內容。
        .Wrap = wdFindContinue
    End With
    '進行修改操作
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

 

效果：

 

(也可以做 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

 

效果：

 

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

  程序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

之前

現在：

 

 

 

附: 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 
(來自網絡)