前言：

對於把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”。
  
一個以上的前一字元或表示式 鍵入 @  
例如，[email protected] 查詢“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