大家好
最近因为工作需求,有大量(数千张)的照片资料要整理
档案连结如下:
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
有没有哪位神人可以帮忙一下,看要如何修改
拜托拜托了!