大家好
最近因為工作需求,有大量(數千張)的照片資料要整理
檔案連結如下:
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
有沒有哪位神人可以幫忙一下,看要如何修改
拜託拜託了!