ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[已解决] 将Excel数据对应写入已做好的Word模板的指定位置(统发)

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-3-4 07:49 | 显示全部楼层

谢谢jsgj2023老师的提醒!
但愿褚老师能原谅我的冒昧

TA的精华主题

TA的得分主题

发表于 2017-3-4 07:59 | 显示全部楼层
jjmysjg 发表于 2017-3-4 07:49
谢谢jsgj2023老师的提醒!
但愿褚老师能原谅我的冒昧

呵呵,我不是老师哦,就一纯粹的小白!只是昨天刚好碰到同样的问题,把褚老师的姓写错了!

TA的精华主题

TA的得分主题

发表于 2017-3-4 08:40 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-3-4 08:45 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
厉害了,。,。,。

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-4 09:34 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
另一种方法:
  1. Private Sub CommandButton生成Word文件_Click()
  2.    Dim Word对象 As New Word.Application, 当前路径, 导出文件名, 导出路径文件名, 判断, i, j
  3.    Dim Str1, Str2
  4.    当前路径 = ThisWorkbook.Path
  5.    最后行号 = Sheets("数据").Range("B65536").End(xlUp).Row
  6.    判断 = 0
  7.    导出文件名 = "工资通知.doc"
  8.    导出路径文件名 = 当前路径 & "" & 导出文件名
  9.    FileCopy 当前路径 & "\工资通知(模板).doc", 导出路径文件名
  10.    With Word对象
  11.       .Documents.Open 导出路径文件名
  12.       .Visible = True
  13.       .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '设置位置在正文
  14.       .Selection.WholeStory '全选
  15.       .Selection.Copy '复制
  16.       If 最后行号 > 3 Then
  17.          For i = 2 To 最后行号 - 1 '复制页
  18.             .Selection.EndKey Unit:=wdStory '光标置于文件尾
  19.             .Selection.InsertBreak Type:=wdPageBreak '分页
  20.             .Selection.PasteAndFormat (wdPasteDefault) '粘贴
  21.          Next i
  22.       End If
  23.       For i = 2 To 最后行号
  24.         For j = 1 To 3 '填写文字数据
  25.             For kk = 1 To 2
  26.            Str1 = "数据" & Format(j, "000")
  27.            Str2 = Sheets("数据").Cells(i, j + 1)
  28.            .Selection.HomeKey Unit:=wdStory '光标置于文件首
  29.            If .Selection.Find.Execute(Str1) Then '查找到指定字符串
  30.               .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
  31.               .Selection.Text = Str2 '替换字符串
  32.            End If
  33.            Next kk
  34.         Next j
  35.       Next i
  36.    End With
  37.    Word对象.Documents.Save
  38.    Word对象.Quit
  39.    Set Word对象 = Nothing
  40.    If 判断 = 0 Then
  41.       i = MsgBox("已生成“" & 导出路径文件名 & "”!", 0 + 48 + 256 + 0, "提示:")
  42.    End If
  43. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2017-3-4 10:03 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
来个最笨的,把模板中的四个数据分别改成“数据001”,“数据002”,“数据003”,“数据004”
Private Sub CommandButton生成Word文件_Click()
   Dim Word对象 As New Word.Application, 当前路径, 导出文件名, 导出路径文件名, 判断, i, j
   Dim Str1, Str2, Str3
   当前路径 = ThisWorkbook.Path
   最后行号 = Sheets("数据").Range("B65536").End(xlUp).Row
   判断 = 0
   导出文件名 = "工资通知.doc"
   导出路径文件名 = 当前路径 & "\" & 导出文件名
   FileCopy 当前路径 & "\工资通知(模板).doc", 导出路径文件名
   With Word对象
      .Documents.Open 导出路径文件名
      .Visible = True
      .ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '设置位置在正文
      .Selection.WholeStory '全选
      .Selection.Copy '复制
           Str1 = Sheets("数据").Cells(2, 2)
           Str2 = Sheets("数据").Cells(2, 3)
           Str3 = Sheets("数据").Cells(2, 4)
           If .Selection.Find.Execute("数据001") Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str1 '替换字符串
              .Selection.MoveRight Unit:=wdCharacter, Count:=1
           End If
           If .Selection.Find.Execute("数据002") Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str2 '替换字符串
              .Selection.MoveRight Unit:=wdCharacter, Count:=1
           End If
           If .Selection.Find.Execute("数据003") Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str1 '替换字符串
              .Selection.MoveRight Unit:=wdCharacter, Count:=1
           End If
           If .Selection.Find.Execute("数据004") Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str3 '替换字符串
              .Selection.MoveRight Unit:=wdCharacter, Count:=1
           End If
      If 最后行号 > 3 Then
         For i = 2 To 最后行号 - 1 '复制页
            .Selection.EndKey Unit:=wdStory '光标置于文件尾
            .Selection.InsertBreak Type:=wdPageBreak '分页
            .Selection.PasteAndFormat (wdPasteDefault) '粘贴
            .Selection.HomeKey Unit:=wdStory
            Str1 = Sheets("数据").Cells(i + 1, 2)
           Str2 = Sheets("数据").Cells(i + 1, 3)
           Str3 = Sheets("数据").Cells(i + 1, 4)
           If .Selection.Find.Execute("数据001") Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str1 '替换字符串
              .Selection.MoveRight Unit:=wdCharacter, Count:=1
           End If
           If .Selection.Find.Execute("数据002") Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str2 '替换字符串
              .Selection.MoveRight Unit:=wdCharacter, Count:=1
           End If
           If .Selection.Find.Execute("数据003") Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str1 '替换字符串
              .Selection.MoveRight Unit:=wdCharacter, Count:=1
           End If
           If .Selection.Find.Execute("数据004") Then '查找到指定字符串
              .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
              .Selection.Text = Str3 '替换字符串
              .Selection.MoveRight Unit:=wdCharacter, Count:=1
           End If
         Next i
      End If
   End With
   Word对象.Documents.Save
   Word对象.Quit
   Set Word对象 = Nothing
   If 判断 = 0 Then
      i = MsgBox("已生成“" & 导出路径文件名 & "”!", 0 + 48 + 256 + 0, "提示:")
   End If
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-3-4 10:28 来自手机 | 显示全部楼层
简单的邮件合并操作,非要丢了西瓜去捡芝麻,其二,说什么“通过vba 写入更加灵活”,我看来也是没事找事,闲的慌!

TA的精华主题

TA的得分主题

发表于 2017-3-4 16:31 | 显示全部楼层
本帖最后由 duquancai 于 2017-3-4 17:18 编辑
jiminyanyan 发表于 2017-3-4 06:32
通过vba 写入更加灵活

简化一下 wordvba 的代码如下:打开Word模板文档,代码放于模块中!》》》》》》》》》》》》》》》

Sub 邮件合并_wdVBA() 'Word2010中测试通过!
    Dim pf$, strSQL$, doc As Document
    Set doc = ThisDocument
    pf = ThisDocument.Path & "\将Excel数据对应写入已做好的Word模板的指定位置(统发).xls"
    strSQL = "select * from `数据$` where 姓名 is not null"
    Call LIKSource(doc, pf, strSQL)
    a = Array("数据001", "数据002", "数据003"): b = Array("姓名", "基础工资", "奖金")
    For i = 0 To UBound(a)
        With doc.Content.Find
            Do While .Execute(a(i))
                doc.MailMerge.Fields.Add .Parent, b(i)
                .Parent.Collapse 0
            Loop
        End With
    Next
    With doc.MailMerge
        .Destination = wdSendToNewDocument
        .DataSource.FirstRecord = wdDefaultFirstRecord
        .DataSource.LastRecord = wdDefaultLastRecord
        .Execute
    End With
    With ActiveDocument
        .SaveAs ThisDocument.Path & "\工资通知(希望达到的效果).docx"
        .Close 0
    End With
    MsgBox "完成并保存!"
End Sub
Sub LIKSource(doc As Document, pf$, strSQL$)
    With doc.MailMerge
        .MainDocumentType = -1
        .MainDocumentType = 0
        .OpenDataSource Name:=pf, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source=pf", SQLStatement:="" & strSQL & ""
    End With
End Sub

TA的精华主题

TA的得分主题

发表于 2017-3-4 16:42 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
duquancai 发表于 2017-3-4 10:28
简单的邮件合并操作,非要丢了西瓜去捡芝麻,其二,说什么“通过vba 写入更加灵活”,我看来也是没事找事, ...

Word对象,找不到工程库

TA的精华主题

TA的得分主题

发表于 2017-3-4 17:23 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-28 20:17 , Processed in 0.058886 second(s), 7 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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