VFP 向 word中追加文本与excel图表,粘贴总是覆盖所有内容
wwle 2017-12-30 03:43:56 VFP 向 word中追加文本与excel图表 (多个图表)
先追加文字,然后粘贴对应的图表
循环操作,总是覆盖所有内容,最后只剩下最后一张图表
我想要的结果是
文字说明1
_______________
| |
| |
| 图1 |
| |
|_______________|
文字说明2
_______________
| |
| |
| 图2 |
| |
|_______________|
但是程序运行完,只剩下最后一个图表,之前 的文字与图表被覆盖了,
代码如下:
LOCAL sfiles(1),ifcount,sdir
sdir=thisform.text2.Value
ifcount=findfiles(sdir,"*.xlsx",@sfiles) && 检索目录下所有excel文件
IF ifcount=0 THEN
RETURN
ENDIF
IF NOT isinstallExcel() THEN
RETURN
ENDIF
IF NOT isinstallWord() THEN
RETURN
ENDIF
LOCAL wordapp,excelapp,worddoc,excelwb,excelsht
wordApp=CREATEOBJECT("Word.application")
Excelapp=CREATEOBJECT("Excel.application")
wordapp.visible=.t.
excelapp.visible=.t.
worddoc=wordapp.documents.add
worddoc.range.InsertParagraphAfter &&换段 想让下一段居左对齐,且换字体,换字号
worddoc.Range.Font.Size= 20
worddoc.range.Font.Name="宋体"
worddoc.Range.Paragraphs.Alignment= 1
worddoc.range.insertafter(ALLTRIM(thisform.text1.Value)+"("+ALLTRIM(STR(ifcount))+" 图表)")
LOCAL i,j,k,sf,fname,fext,wRange
LOCAL n1,n2
wRange=worddoc.range
FOR i=1 TO ifcount
sf=sfiles(i)
fname=JUSTFNAME(sf)
fext=JUSTEXT(sf)
fname=LEFT(fname,LEN(fname)-LEN(fext)-1)
excelwb =excelapp.workbooks.open(sf)
excelsht=excelwb.sheets("柱状图")
excelsht.chartarea.copy &&复制图表
wRange.InsertParagraphAfter
wRange.Font.Size= 12
wRange.Font.Name="宋体"
wRange.Paragraphs.Alignment= 0
wRange.insertafter(fname) &&追加文字
wRange.InsertParagraphAfter
*worddoc.range.PasteAndFormat (15) && 报错
*worddoc.selection.paste &&为什么不让selection
wrange.paste && 这样可以粘上,但是只有最后一张保留所有文字没有了.
excelwb.close
NEXT
以下是word录制
Sub 宏1()
'
' 宏1 宏
'
'
Selection.TypeText Text:="aaaaaaaaaaaaaa"
Selection.TypeParagraph
Selection.TypeText Text:="bbbbbbbbbbbbbbbbbbbbb"
Selection.TypeParagraph
Selection.PasteAndFormat (wdChartLinked)
Selection.TypeParagraph
Selection.PasteAndFormat (wdChartLinked)
Selection.TypeParagraph
Selection.TypeText Text:="78878"
Selection.TypeParagraph
Selection.TypeText Text:="67jytjjtjty"
Selection.TypeParagraph
End Sub
Sub 宏2()
'
' 宏2 宏
'
'
Selection.PasteAndFormat (wdChartLinked)
End Sub