[VBA ] 自動貼圖後，可以新增相同表格後再貼圖

看板Visual_Basic作者icywind31 (icywind)時間9年前 (2015/08/12 10:19)推噓0(0推 0噓 3→)

留言3則, 2人參與討論串1/1

大家好最近因為工作需求，有大量(數千張)的照片資料要整理檔案連結如下: https://www.dropbox.com/s/ifo39wywg85fxva/456.docx?dl=0 想要將圖片貼在大格子內，然後每貼完3張圖片就新增頁面再複製表後，繼續貼圖! 如果要自己一個一個慢慢貼，則調整圖片大小會花很多時間因此，有爬了google上的大家寫了一串VBA 勉強可以自動讀入所有圖片檔但是卻卡在不會自己換頁新增相同表格後再繼續貼圖! VBA編碼如下: 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 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.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.InlineShapes.AddPicture FileName:= _ strFileLocation & "\" & oFl.Name, LinkToFile:=False, SaveWithDocument:=True ''偏移游標 Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell 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 有沒有哪位神人可以幫忙一下，看要如何修改拜託拜託了! -- ※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 220.134.245.161 ※ 文章網址: https://www.ptt.cc/bbs/Visual_Basic/M.1439345963.A.9C2.html