ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2495|回复: 14

[求助] vba操作word时如何定位复制插入?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-8 09:40 | 显示全部楼层 |阅读模式
excel中的数据,要替换word中的内容,现在有一数据,替换时有时有一条记录,有时多条,如何生成多条呢?
如“在数据003仓库”,现在订单号001有两个仓库(4号,3号)发货,如何把模板的“在数据003仓库,”,多复制一条,替换结果为“在4号仓库,在3号仓库,”,而下面的 “有数据004已发出”,也有两条记录,如何复制成两个段落,替换结果如下
已发出

夹子已发出
1.JPG 2.JPG
替换.zip (16.57 KB, 下载次数: 17)




TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-9 21:50 | 显示全部楼层
求教,主要是word中如何控制部份数据生成多条记录

TA的精华主题

TA的得分主题

发表于 2020-1-10 10:42 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-10 11:32 | 显示全部楼层
本帖最后由 sblisb 于 2020-1-14 09:58 编辑

谢谢,麻烦你了
能不能不发图片呀,贴出代码好复制修改
Sub lqxs()
'引用 Microsoft Word15.0 Object Library
Dim Arr,i&, Str1$, Str2$, Brr, d, k, cz
Dim WD As New Word. Application, doc, ii%
Dim tt, aa, jj%, s3$, s4$
Application. ScreenUpdating=False
cz= Array("数据001","数据002","数据003","数据004")
Sheet1.Activate
Arr=[a1]. CurrentRegion
Brr=[e1]. CurrentRegion
Set d=CreateObject("Scripting.Dictionary")
For i=2 To UBound(Brr)
d(Brr(i, 1)) = d(Brr(i, 1)) & i & ","
Next
k =d.keys
With WD
.Visible=True
Set doc = .Documents. Open(ThisWorkbook. Path & "\模本.docx")
WD. Selection. HomeKey wdStory'将插入点移至文档开头
With doc
For i=2 To UBound(Arr)
  If d. Exists(Arr(i, 1))Then
   tt=d(arr(i,1)):s3="":s4=""
   tt=Left(tt, Len(tt)-1)
   If InStr(tt, "," ) Then
    aa=Split(tt, ",")
    For jj= 0 To UBound(aa)
     If s3="" then
        s3 = Brr(aa(jj), 2) & "仓库,"
       s4 = Brr(aa(jj), 3) & "已发出,"
     ElseIf jj < UBound(aa) Then
      s3=s3 & "在" & Brr(aa(jj),2) & "仓库,"
      s4=s4 & "有" & Brr(aa(jj),3) & "已发出,"
     Else
      s3=s3 & "在" & Brr(aa(jj),2)
      s4=s4 & "有" & Brr(aa(jj),3)
     End If
    Next
   Else
    s3=Brr(tt, 2)
    s4= Brr(tt, 4)
   End If
   For j = 0 To UBound(cz)
   Str1 = cz(j)
   If j<2 Then
    Str2= Arr(i, j+1)
   ElseIf j=2 Then
    Str2=s3
   Else
    Str2=s4
   End If
   With WD. Selection. Find'使用查找命令
    .ClearFormatting'不限定格式
    .Forward = True
    .Execute Str1'查找并选中str1及其后的段落标记
    With WD. Selection. Find
     .ClearFormatting
     .Forward = True
     .Replacement. Text = Str2
     .Execute Replace: =wdReplaceAll
    End With

   End With
   Next
   . SaveAs ThisWorkbook.Path & "\订单号" & Arr(i,1) & ".docx"
   .Close

  End If
Next
End With
End With
Set WD= Nothing
Application. ScreenUpdating =True
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-10 15:34 | 显示全部楼层
1.JPG

引用的是Microsoft Word16.0 Object Library


提示“该部件的许可信息没有找到”
怎么解决?

TA的精华主题

TA的得分主题

发表于 2020-1-11 09:29 | 显示全部楼层
或者改为后期绑定
删除前面的WD As New Word. Application,

Set WD = CreateObject("word.application")
不过引用15、16应该不会出现问题的,可能还是有抄错的地方

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-11 23:28 | 显示全部楼层
蓝桥玄霜 发表于 2020-1-11 09:29
或者改为后期绑定
删除前面的WD As New Word. Application,

我在调试菜单中逐语句运行
停在这一句
Set d = CreateObject("Scripting. Dictionary")
是字典还要什么运行库吗?

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-11 23:33 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2020-1-12 11:16 | 显示全部楼层
Set d = CreateObject("Scripting. Dictionary")
中的.是不是用了汉字的.  还是多了一个空格" "?
用了这句,就是后期绑定,不需要引用runtime

TA的精华主题

TA的得分主题

发表于 2020-1-12 11:37 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
WORD与EXCEL交互,学习蓝老师的代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 18:30 , Processed in 0.051108 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表