如果满足条件,将Word中的段落复制到下一页(宏) [英] Copy paragraphs from Word into the next page if the condition is met (macro)
问题描述
我正在尝试创建宏,该宏将在特定条件下将数据从Excel文件导出到Word文档中.表格中的每一行都附有照片-有时1张,有时更多.我想粘贴表格中的文字,然后粘贴下面的照片.如果我当前的行中附加了多于1张照片,那么我想将相同的文本复制到下一页并在下面粘贴下一张照片.结果,我每页将有1张带有说明的照片.
I am trying to create macro which is going to export data from Excel file into Word document with specific conditions. Each row in the table has photos attached - sometimes 1 and sometimes more. I would like to paste text from the table and then the photo below. If my current row has more than 1 photo attached, then I would like to copy the same text to the next page and paste next photo below. As a result I will have 1 photo per page with the description.
现在我有一个代码,可以通过计算两个前几个数字来检查照片的名称(例如:66_foto1.jpg,66_foto2.jpg,67_foto1.jpg),但是我不确定如何在下一个开始时复制文本页面.
For now I have a code which is checking photo's name by counting two first numbers (example: 66_foto1.jpg, 66_foto2.jpg, 67_foto1.jpg) but I am not sure how to copy the text at the begining of the next page.
部分代码:
Dim fso As Object
Dim objfolder As Object
Dim objfile As Object
Dim lCount As Long 'number of photo starts with 66_
Dim strpath As String
Dim objsub As Object
strpath = "C:\xxx\photos" 'path where photos are located
Set fso = CreateObject("Scripting.FileSystemObject")
Set objfolder = fso.GetFolder(strpath)
For Each objfile In objfolder.Files
If UCase(objfile.Name) Like "66_*" Then lCount = lCount + 1
Next objfile
Dim imagePath As String
For i = 1 To lCount
imagePath = "C:\xxx\photos\" & "66_" & "Foto " & i & ".jpg"
objWord.Selection.InlineShapes.AddPicture Filename:= _
imagePath, LinkToFile:=False, _
SaveWithDocument:=True
objWord.Selection.TypeParagraph
Next
目前只有一张照片.66,但我想创建变量并计算不同的变量.
For now there is just photo no. 66, but I would like to make variables and count different ones.
推荐答案
将文本和图片粘贴到两行表中,第一行标记为标题行.此后,任何导致新行在新页面上开始的操作都将复制该页面上的标题行.不需要文本复制代码;如果需要的话,以后更新也更容易.
Paste both the text and the picture into a two-row table, with the first row marked as a header row. Thereafter, anything that causes a new row to start on a new page will replicate the header row on that page. No text replication code required; it's also simpler to update later if needed.
例如(作为Word宏-即不是从Excel自动执行,我将留给您):
For example (as a Word macro - i.e. not automated from Excel, which I'll leave to you):
Sub AddPics()
Application.ScreenUpdating = False
Dim wdDoc As Word.Document, wdTbl As Word.Table, strPic As String, r As Long
Const strFldr As String = "C:\xxx\photos\": r = 1
Set wdDoc = ActiveDocument
With wdDoc
Set wdTbl = .Tables.Add(Range:=.Bookmarks("MyBookmark").Range, NumRows:=1, NumColumns:=1)
With wdTbl
.Rows.Alignment = wdAlignRowCenter
.PreferredWidthType = wdPreferredWidthPoints
.PreferredWidth = InchesToPoints(6)
.Range.Cells(1).Range.Text = "Excel text"
strPic = Dir(strFldr & "66_*.jpg", vbNormal)
Do While strPic <> ""
r = r + 1
.Rows.Add
With .Rows(r)
.HeightRule = wdRowHeightExactly
.Height = InchesToPoints(6)
.AllowBreakAcrossPages = False
.Range.InlineShapes.AddPicture FileName:=strFldr & strPic, Range:=.Cells(1).Range
End With
strPic = Dir()
Loop
.Rows(1).HeadingFormat = True
End With
End With
Application.ScreenUpdating = True
End Sub
上面的代码将插入所有66 _ *.jpg图片,并在每个图片上方显示"Excel文本".按照编码,图片尺寸会按照正确的纵横比自动限制为6in * 6in.
The above code will insert all the 66_*.jpg pics and have the 'Excel text' appear above each pic. As coded, pic sizes are automatically limited to 6in*6in at their correct aspect ratios.
请注意:StackOverflow不是免费的编码论坛.
Please note: StackOverflow is not a free coding forum.
这篇关于如果满足条件,将Word中的段落复制到下一页(宏)的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!