使用巨集(Macro)加入圖片,並調整大小(長寬)及建立表格

為了要快速建立圖片在 Word 的表格中,並調整大小,
寫了一個巨集(Macro) 大陸用語叫"宏",
目前這個巨集只是寫暫時能執行,算是堪用,
有需要的朋友可以自行修改成更適合自己的程式。

首先,只要將新建的 Word 檔和要加入的圖檔放在同一個目錄下,

開啟 Word,選到巨集的 VB 編輯器

然後把以下的程式碼貼上編輯器
＜＜本範例使用 Microsoft Office Word 2003＞＞

Public Sub LoadPicture()
    Dim myRow As Integer
    Dim myCol As Integer
    
    myRow = InputBox("請輸入列數 (Rows)", "Row Size", 2)
    myCol = InputBox("請輸入欄位數 (Cols)", "Col Size", 3)

    With Application.FileSearch
        .FileName = "*.jpg"
        .LookIn = ActiveDocument.Path
        .Execute
        For I = 1 To .FoundFiles.Count
            ''插入圖片
            Selection.InlineShapes.AddPicture FileName:= _
            .FoundFiles(I), LinkToFile:=False, SaveWithDocument:=True
            ''在圖片右邊輸入逗號
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            Selection.TypeText Text:=","
        Next I
    End With

    Selection.WholeStory    '全選
    ''轉換文字形態成表格
    Selection.ConvertToTable Separator:=wdSeparateByCommas, NumColumns:=myCol, _
        NumRows:=myRow, AutoFitBehavior:=wdAutoFitFixed
    ''最到第一頁,最前頭
    Selection.HomeKey Unit:=wdLine
    Selection.HomeKey Unit:=wdStory
    ''呼叫副程式調整所有圖片大小
    AllPictSize
    
End Sub

''調整圖形大小
Sub AllPictSize()
    Dim picWidth As Integer
    Dim picHeight As Integer
    Dim oIshp As InlineShape
    
    picHeight = InputBox("請輸入照片高度", "Resize Picture", 128)
    picWidth = InputBox("請輸入照片寬度", "Resize Picture", 120)

    For Each oIshp In ActiveDocument.InlineShapes
        With oIshp
            .Height = picHeight
            .Width = picWidth
        End With
    Next oIshp
End Sub

==== 2014/10/09 新增 2007 範例 START ====
Office 2007 的使用要多引用 Microsoft Scripting Runtime
首先,在巨集編輯畫面的上方,找到[工具] - [設定引用項目]

再來找到 [Microsoft Scripting Runtime] 並將它勾選起來。

最後把以下程式碼貼上
＜＜本範例使用 Microsoft Office Word 2007＞＞

Public Sub LoadPicture()
    Dim myRow As Integer
    Dim myCol As Integer
    
    Dim fso As New FileSystemObject
    Dim oFldr As Folder
    Dim oFl As File
    Dim strFileLocation As String
    
    myRow = InputBox("請輸入列數 (Rows)", "Row Size", 2)
    myCol = InputBox("請輸入欄位數 (Cols)", "Col Size", 3)
 
    strFileLocation = ActiveDocument.Path

    ' Use this snippet for office 2007
    Set oFldr = fso.GetFolder(strFileLocation)
    'intI = 1
    For Each oFl In oFldr.Files
        If Right(oFl.Name, 4) = ".jpg" Then
            ''插入圖片
            Selection.InlineShapes.AddPicture FileName:= _
            strFileLocation & "\" & oFl.Name, LinkToFile:=False, SaveWithDocument:=True
            ''在圖片右邊輸入逗號
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            Selection.TypeText Text:=" "

        End If
    Next

    ''呼叫副程式調整所有圖片大小
    AllPictSize
     
End Sub
 
''調整圖形大小
Sub AllPictSize()
    Dim picWidth As Integer
    Dim picHeight As Integer
    Dim oIshp As InlineShape
     
    picHeight = InputBox("請輸入照片高度", "Resize Picture", 250)
    picWidth = InputBox("請輸入照片寬度", "Resize Picture", 250)
 
    For Each oIshp In ActiveDocument.InlineShapes
        With oIshp
            .Height = picHeight
            .Width = picWidth
        End With
    Next oIshp
End Sub

==== 2014/10/09 新增 2007 範例 END ====


執行巨集(Macro)

執行時會要求輸入一些設定值

載入的圖片會以圖檔的檔名順序依序插入,並建立表格。

當然,若是只要調整圖片大小,
執行巨集時就選擇 [AllPictSize]
這樣就不會重覆載入圖檔,只會調整大小囉~~


參考資料
調整圖片大小
批次插入圖片

今天是 20111102

20111102 這個數字不管是左邊看來還是右邊看都一樣,
2011/11/02 今天果然是個特別的日子。