2个疑难问题请高人解决--将Excel数据写入Word模板时

yyyyu10

将Excel数据写入Word模板时存在2个问题？？？？？
1、当EXCEL某行数据需要重复引用时，自动错误读取下一行对应列数据。
2、当EXCEL某单元格数据为函数公式产生时，word无法读取该单元格对应列数据。

附本论坛高手的VBA代码：
   Dim Str1, Str2
   当前路径 = ThisWorkbook.Path
   最后行号 = Sheets("信息").Range("B65536").End(xlUp).Row
   判断 = 0
   导出文件名 = "公文.doc"
   导出路径文件名 = 当前路径 & "\" & 导出文件名
   FileCopy 当前路径 & "\公文(模板).doc", 导出路径文件名
   With Word对象
      .Documents.Open 导出路径文件名
      .Visible = False
'      .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader '设置位置在页眉
'      Str1 = "数据006"
'      Str2 = Sheets("信息").Cells(2, 2)
'      .Selection.HomeKey Unit:=wdStory '光标置于文件首
'      If .Selection.Find.Execute(Str1) Then '查找到指定字符串
'         .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
'         .Selection.Text = Str2 '替换字符串
'       End If
'      .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter '设置位置在页脚
'      Str1 = "数据007"
'      Str2 = Sheets("信息").Cells(2, 1)
'      .Selection.HomeKey Unit:=wdStory '光标置于文件首
'      If .Selection.Find.Execute(Str1) Then '查找到指定字符串
'         .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
'         .Selection.Text = Str2 '替换字符串
'         End If
      .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '设置位置在正文
      .Selection.WholeStory '全选
      .Selection.Copy '复制
      If 最后行号 > 3 Then
         For i = 2 To 最后行号 - 1 '复制页
            .Selection.EndKey Unit:=wdStory '光标置于文件尾
            .Selection.InsertBreak Type:=wdPageBreak '分页
            .Selection.PasteAndFormat (wdPasteDefault) '粘贴
         Next i
      End If
      For i = 4 To 最后行号
        For j = 1 To 38 '填写文字数据
           Str1 = "数据" & Format(j, "000")
           Str2 = Sheets("信息").Cells(i, j + 1)
           .Selection.HomeKey Unit:=wdStory '光标置于文件首
     If .Selection.Find.Execute(Str1) Then
   .Selection.Font.Color = wdColorAutomatic
   .Selection.Text = Str2
End If
        Next j
'        For j = 1 To 3 '填写表格数据
'           .ActiveDocument.Tables(i - 1).Cell(2, j).Range = Sheets("WPS").Cells(i, j + 6)
'           .ActiveDocument.Tables(i - 1).Cell(4, j).Range = Sheets("WPS").Cells(i, j + 9)
'        Next j
      Next i
   End With
   Word对象.Documents.Save
   Word对象.Quit
   Set Word对象 = Nothing
   If 判断 = 0 Then
      i = MsgBox("已生成“" & 导出路径文件名 & "”！", 0 + 48 + 256 + 0, "提示：")
   End If
End Sub

yyyyu10

在线等 高人解决。。。。。

zhaogang1960

第二个问题单元格加一个value即可：Str2 =Sheets("信息").Cells(2, 2).value

第一个问题是不是Word中有多个相同需要替换的"数据xxx"？如果是需要加一个循环查找：
Do While .Selection.Find.Execute(Str1)
    .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
    .Selection.Text = Str2 '替换字符串
    .Selection.HomeKey Unit:=wdStory
Loop

yyyyu10

版主果然出手不凡，第二个问题经测试已经解决，但第一个问题加了语句后测试没成功，不知道是不是加错位置了，请告知具体的加入位置，谢谢！

l另外还有两个问题需要请教，详见附件文件。
1、如果EXCEL表格中每行由4行组成，即每行的每个单元格由4行合并而成，但后面有一列的单元格需要提供4行数据没有合并，原公式该怎么进行修改？（即从i=3,i=3+4...开始依次生成WORD文件，但每个WORDW文件需要依次读4行数据）。
2、EXCEL文件中某列单元格为AUTOCAD图形文件复制到单元格，有没有办法批量生成WORD文件中呢？电子签名图片格式同理有没有办法批量生成WORD文件中呢？

zhaogang1960

yyyyu10 发表于 2011-10-22 10:37
版主果然出手不凡，第二个问题经测试已经解决，但第一个问题加了语句后测试没成功，不知道是不是加错位置了 ...

第一个问题：for i=2 to 最后行号 step 4
公式和图片我不会

yyyyu10

再次谢谢版主的解答，不过公式还是没能测试好，期望论坛的朋友继续给予关注和指导！！！

yyyyu10

第一个问题是不是Word中有多个相同需要替换的"数据xxx"？如果是需要加一个循环查找：
Do While .Selection.Find.Execute(Str1)
    .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
    .Selection.Text = Str2 '替换字符串
    .Selection.HomeKey Unit:=wdStory
Loop
这个语句应该加在公式的哪个位置才对啊？？？

yyyyu10

怎么没人能解决吗？？？

shaojinliu

等高手解决！

liucqa

yyyyu10 发表于 2011-10-22 10:37
版主果然出手不凡，第二个问题经测试已经解决，但第一个问题加了语句后测试没成功，不知道是不是加错位置了 ...

从单元格得到图片对象，需要使用Window.RangeFromPoint 方法，但这个方法不能用于2007