注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

零售创新,创新那些事儿,SPSS,VBA

零售创新

 
 
 

日志

 
 
关于我

新浪微博,零售创新 研究经理,数据分析师 希望和市场研究和零售业的同事共同进步! 本博客发表的都是免费或试用的资料,如果有版权问题请发邮件wangli12a@163.com联系删除。 spss excel vba blog

网易考拉推荐

利用access VBA批量输出word文档 + Excel VBA (转)  

2012-03-31 17:28:55|  分类: VB和VBA知识 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

利用access VBA批量输出word文档 + Excel VBA (转)

  Option Compare Database
Private Sub cmdExportAll_Click()
    Dim rownum As Integer
    Dim I, N As Integer
    '使用DAO操作打开明细记录集
    Dim rs As DAO.Recordset
    Dim sqlStr As String
    '单库多表查询,需事先将数据集中到一个mdb中
    'sqlStr = "Select * from ckq b , yckq a where b.证号=a.证号"
    '跨库多表查询,连接多个mdb中数据表
    sqlStr = "Select * from [;database=" & CurrentProject.Path & "\ckq.mdb].ckq b , [;database=" & CurrentProject.Path & "\yckq.mdb].yckq a where b.证号=a.证号"
    Set rs = CurrentDb.OpenRecordset(sqlStr)
    '如果没有记录 , 不执行下面程序
    If rs.EOF Then Exit Sub
    '为了能得到记录总数量,DAO记录集要先把记录集位置移到最后,否则得不到RECORDCOUNT
    rs.MoveLast
    rs.MoveFirst
    rownum = rs.RecordCount
    '多条数据的处理,使用循环
    For I = 1 To rownum
        '创建Word对象
        Set doc = CreateObject("word.application")
        doc.Visible = True
        '打开Word文件
        Dim mydoc As Object
        Set mydoc = doc.Documents.Add(CurrentProject.Path & "\表格模板.doc") '使用定义好的模板创建新文件
        'mydoc.Bookmarks("template_content_en").Range.Text = (rs!测试字段)
        '(rs.Fiel(ds(0).Name) '(rs.Fields(0).Value)
        '最后面加上 & "" 避免了当字段为NULL时程序出错中断,省却不少代码行与麻烦,真TMD太有用了
        mydoc.Bookmarks("证号").Range.Text = rs.Fields("b.证号").Value & ""
        mydoc.Bookmarks("项目名称").Range.Text = rs.Fields("b.项目名称").Value & ""
        mydoc.Bookmarks("a传真").Range.Text = rs.Fields("a.传真").Value & ""
        mydoc.Bookmarks("b传真").Range.Text = rs.Fields("b.传真").Value & ""
        mydoc.Bookmarks("a电话").Range.Text = rs.Fields("a.电话").Value & ""
        mydoc.Bookmarks("b电话").Range.Text = rs.Fields("b.电话").Value & ""
        mydoc.Bookmarks("a地址").Range.Text = rs.Fields("a.地址").Value & ""
        mydoc.Bookmarks("b地址").Range.Text = rs.Fields("b.地址").Value & ""
        '以下省略N项
        '.........
        '.........
        Select Case rs.Fields("a.项目类型").Value & ""
            Case "1"
                mydoc.Bookmarks("a1").Range.Text = "√"
                mydoc.Bookmarks("a2").Range.Text = ""
            Case "2"
                mydoc.Bookmarks("a1").Range.Text = ""
                mydoc.Bookmarks("a2").Range.Text = "√"
            Case Else
                mydoc.Bookmarks("a1").Range.Text = ""
                mydoc.Bookmarks("a2").Range.Text = ""
        End Select
        '以下为坐标数字串,XY坐标分开存储,X11位,Y12位,读取时根据位数截取
        'mid("1234",2,2)
        'mid(string,start,len)
        'Mid("1234",   insrt("1234","23"),   len("23"))
        Dim XA, YA, XB, YB As String
        XA = rs.Fields("a.经度坐标").Value & ""
        YA = rs.Fields("a.纬度坐标").Value & ""
        XB = rs.Fields("b.经度坐标").Value & ""
        YB = rs.Fields("b.纬度坐标").Value & ""
        'Dim XYnum As Integer
        'XYnum = Len(XB) / 11
        For N = 1 To 22
           mydoc.Bookmarks("XA" & N).Range.Text = Mid(XA, N * 11 + 1, 11) & ""
           mydoc.Bookmarks("YA" & N).Range.Text = Mid(YA, N * 12 + 1, 12) & ""
           mydoc.Bookmarks("XB" & N).Range.Text = Mid(XB, N * 11 + 1, 11) & ""
           mydoc.Bookmarks("YB" & N).Range.Text = Mid(YB, N * 12 + 1, 12) & ""
        Next
        'If XYnum < 14 Then
        '  For N = XYnum + 1 To 14
        '    mydoc.Bookmarks("XB" & N).Range.Text = ""
        '    mydoc.Bookmarks("YB" & N).Range.Text = ""
        '  Next
        ''Else
        'End If
        '保存word文档
        mydoc.SaveAs CurrentProject.Path & "\" & rs.Fields("a.项目名称").Value & ".doc"
        '释放对象变量
        Set doc = Nothing
        rs.MoveNext
    Next
    rs.Close
End Sub

  评论这张
 
阅读(940)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017