作者icywind31 (icywind)
看板Visual_Basic
标题[VBA ] 自动贴图後，可以新增相同表格後再贴图
时间Wed Aug 12 10:19:19 2015
大家好
最近因为工作需求，有大量(数千张)的照片资料要整理
档案连结如下:
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://webptt.com/cn.aspx?n=bbs/Visual_Basic/M.1439345963.A.9C2.html
1F：→ MOONRAKER: 直接出HTML 用<p style="page-break-after:always"> 08/12 13:53
2F：→ MOONRAKER: 分页 大概比较快 08/12 13:53
3F：→ icywind31: M大讲的东西...对我来说有些难懂，可以在指点指点吗? 08/13 19:47