→ MOONRAKER: 直接出HTML 用<p style="page-break-after:always"> 08/12 13:53
→ MOONRAKER: 分頁 大概比較快 08/12 13:53
→ icywind31: M大講的東西...對我來說有些難懂，可以在指點指點嗎? 08/13 19:47
大家好
最近因為工作需求，有大量(數千張)的照片資料要整理
檔案連結如下:
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