精华内容
下载资源
问答
  • 公文自动排版VBA代码

    2018-05-08 09:34:04
    使用vba代码,使得繁琐的公文排版工作变成自动化的享受!
  • word自动排版,公文自动排版,word自动排版 高效办公,提高办公效率 很好的选择,可以自动设置很多需要手动重复操作的内容!
  • VBA代码在试题自动组卷中的排版应用。减轻了教师的工作量
  • 笔者的使用环境是SQL-SERVER2014 和VS2017 首先在SQL-server中建立如下表格 ...以下是word中的VBA代码: '——————————————————————————————声明公共变量 Public rs As New AD...

    笔者的使用环境是SQL-SERVER2014 和VS2017

    首先在SQL-server中建立如下表格
    序号 列名1 列名2
    001 aa bb
    002 bb cc
    003 cc aa

    以下是word中的VBA代码:
    '——————————————————————————————声明公共变量

    Public rs As New ADODB.Recordset
    Public cnn As New ADODB.Connection
    Public SQL As String
    
    Sub test()
    
    Dim arr_ori()
    Dim arr_rep()
        '——————————————————————————————打开数据库 
    rs.open("Provider=SQLOLEDB;server=服务器名称;Persist Security Info=True;User ID=用户名;Password=密码;Initial Catalog=数据库")
         '——————————————————————————————读取数据库并为数组1赋值  
    SQL = "SELECT 列名1 FROM 表名 "
    Set rs = cnn.Execute(SQL)
    arr_ori() = rs.GetRows
             '——————————————————————————————读取数据库并为数组2赋值  
    SQL = "SELECT 列名2 FROM 表名"
    Set rs = cnn.Execute(SQL)
    arr_rep() = rs.GetRows
            '——————————————————————————————将数组1的内容替换为数组2  
    For i = 1 To UBound(arr_ori, 2)
        With Selection.find
            .text = Trim(arr_ori(0, i))
            .Replacement.text = Trim(arr_rep(0, i))
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False            
            .MatchCase = False        
            .MatchWholeWord = False    
            .MatchByte = False          
            .MatchWildcards = False    
            .MatchSoundsLike = False   
            .MatchAllWordForms = False  
        End With
            Selection.find.Execute Replace:=wdReplaceAll
    Next i
    
    rs.close
    
    End Sub
    

    注:由于getrows获取的数组为二维数组,因此在使用时,应当注意维度设置,否则会报错。如果需要批量删除数组1的内容,则 .Replacement.text = Trim(arr_rep(0, i))改为 .Replacement.text =""即可。

    上述代码的其他用法:翻译词组的批量替换,亲测效果还可以。

    展开全文
  • 楼主比较懒,代码只提供了提取关键词短句的部分,并未加入重复检测功能 待提取的word文档格式如下:(关键词为XX) aaaxxaa bbbxxbb sssss ccccxxcc sddssfsdf sdfsdfxxdddd 以下代码能够实现批量提取出word文档内的带...

    在做数据筛选时,会要求提取带有特定关键词的短句。
    楼主比较懒,代码只提供了提取关键词短句的部分,并未加入重复检测功能
    待提取的word文档格式如下:(关键词为XX)
    aaaxxaa
    bbbxxbb
    sssss
    ccccxxcc
    sddssfsdf
    sdfsdfxxdddd

    以下代码能够实现批量提取出word文档内的带有关键词的数据

    Sub 提取内容()
        Dim temp_text, text_output As String
        i = 0
        Do
        With Selection.find
            .Text = "需要搜索的关键词"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
        End With
        Selection.find.Execute
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        i = i + 1
        text_output = text_output & Selection.Text & Chr(13)
            If i = 500 Then
            Exit Do
            End If
        Selection.EndKey Unit:=wdLine
        Selection.MoveRight
        Loop
        
        Documents.Add.Content.Text = text_output
        ActiveDocument.SaveAs ("路径\1.docx")  '输出成独立的word文档
        
    End Sub
    

    生成的1.docx的格式
    aaaxxaa
    bbbxxbb
    ccccxxcc
    sdfsdfxxdddd

    展开全文
  • 在提取数据时,会遇到具有相似格式的内容,例如同一...必须先将所有符合这种格式的数据找出后形成数组,然后进行批量替换,如果手动录入会非常麻烦,那么可以用到下述代码。以下以字符长度L为第二判别条件实现降噪,...

    在提取数据时,会遇到具有相似格式的内容,例如同一个word文档中出现了“(C01B35/06优先)”、(C01C11/00优先),(C01C18/00优先)……等,其存在相似的通配符格式,即"\(*优先\)",但如果直接全部替换,又有可能误删数据。
    必须先将所有符合这种格式的数据找出后形成数组,然后进行批量替换,如果手动录入会非常麻烦,那么可以用到下述代码。以下以字符长度L为第二判别条件实现降噪,将需要删除的数据直接筛出,然后进行批量替换

    先通过for循环和With Selection.Find 将带有上述格式的,且字符长度<=20的全部数据存储在a(0 to 1000)中。
    然后在以赋值后的a(0 to 1000)作为被替换文本进行批量replace成""即可。

    注:如果电脑配置不高,建议将数组a的上限调小,分批次进行,否则电脑会假死。如果假死则可通过CTRL+PAUSE BREAK(num lock 左上的按钮)暂停

    Sub 替换文本()
    Dim a(0 To 1000) As String
    Dim search As String
    Selection.HomeKey Unit:=wdStory
        For i= 1 To UBound(a)
        With Selection.Find
             .Text = "\(*优先\)"
             .Replacement.Text = ""
             .Forward = True
             .Wrap = wdFindStop
             .MatchWildcards = True     '使用通配符
        End With
        Selection.Find.Execute
        search = Selection.Text
        L = Len(Selection.Text)
        If L <= 20 Then
        a(i) = Selection.Text
        End If
    Next i
    
    For i = 1 To UBound(a)
      With Selection.Find
         .Text = a(i)
         .Replacement.Text = ""
         .Forward = True
         .Wrap = wdFindContinue
          .MatchWildcards = False    '不使用通配符
     End With
         Selection.Find.Execute Replace:=wdReplaceAll
    Next i
    
    End Sub
    
    展开全文
  • 代码原理为通过自建数组和通配符替换逐一替换,无需引入其他数据库,运行速度还可以。 代码如下: Sub 替换文本() '替换前文本 Orit = Array("(&lt;[!^13]*^13)(*)\1", "(&lt;[!^13]*^13.....

    叠字主要包括以下几种:
    1型aabbcc
    2型ababab
    3型abcabcabc
    4型abcdabcdabcdabcd(这个算思考题,自己根据原理增加吧)
    代码原理为通过自建数组和通配符替换逐一替换,无需引入其他数据库,运行速度还可以。
    代码如下:

    Sub 替换文本()
     '替换前文本
     Orit = Array("(<[!^13]*^13)(*)\1", "(<[!^13]*^13)(*)\1", "(<[!^13]*^13)(*)\1", _
        "([!1-^127]){3}", "([!1-^127]){2}", _
        "([!^13]){4}", "([!^13]){3}", "([!^13]){2}", _
        "([!^13])([!^13])\1\2{4}", "([!^13])([!^13])\1\2{3}", "([!^13])([!^13])\1\2{2}", _
        "([!^13])([!^13])([!^13])\1\3{4}", "([!^13])([!^13])([!^13])\1\3{3}", "([!^13])([!^13])([!^13])\1\3{2}")
            
        '替换后文本
        Rept = Array("\1\2", "\1\2", "\1\2", _
        "\1", "\1", _
        "\1", "\1", "\1", _
        "\1", "\1", "\1", _
        "\1", "\1", "\1")
     
     For i = 0 To UBound(Orit)
          With Selection.Find
             .Text = Orit(i)
             .Replacement.Text = Rept(i)
             .Forward = True
             .Wrap = wdFindContinue
             .Format = False
             .MatchCase = False
             .MatchWholeWord = False
             .MatchByte = False
             .MatchWildcards = True  '运用通配符
             .MatchSoundsLike = False
             .MatchAllWordForms = False
         End With
             Selection.Find.Execute Replace:=wdReplaceAll
        Next i
    End Sub
    

    注:
    {数字}为重复次数,
    [!^13]为非段落标记
    (<[!13]*13)()\1中:
    (<[!13]*13)为查找一段内容;
    <[!^13]表示段落的首字
    (
    )表示0个或N个内容
    , _为换行符,注意有空格
    \1表示是第一个表达式的内容
    \2表示是第二个表达式的内容
    ([!^13])用于去除aa叠字
    ([!13])([!13])\1\2用于去除asas叠字,
    ([!13])([!13])([!^13])\1\3用于去除asdasd叠字
    ([!^13])个数即被重叠的字符单元数量,与第二个\数字相对应,重复单元为三个字符,则为\3;重复单元为2个字符,则为\2,以此类推

    展开全文
  • Word VBA自动排版(3)- 去除空白段落

    千次阅读 2019-01-22 10:21:10
    代码一则 Sub 删除空白段落() For Each para In ActiveDocument.Paragraphs If Right(para.Range.Text, 2) &amp;lt;&amp;gt; &quot;。&quot; &amp;amp; Chr(13) Then para.Range....
  • 就是一个通过VBA实现的word宏,代码虽然比较LOW,但是很好用。 该宏可以同时实现新建窗口、并排查看和取消同步滚动,如果需要保留同步滚动,只需在相应处进行修改即可。 兼容了doc和docx格式 代码如下 Sub 分窗口...
  • 代码比较简单,只是在替换的基础上增加了最基础的For循环,有效节省了批量替换文本的时间。 废话不多说,直接上代码, Ori = Array("a","b","c") '被替换文本 Rep = Array("a&...
  • 我们拿从数据库导出来的数据做面板回归时原始数据往往不是按Stata面板数据格式排版的,这个代码能使下载到excel中的数据自动转化为stata面板数据的排版数据,里面附有详细的操作说明
  • 专利说明书在撰写时,如遇到附图标记过多时,往往需要手动替换各部件以增加附图标记,较为耗时,通过下述代码可对文中的所有部件快速标记,通常只需几秒。 Sub 自动增加附图标记() Dim fea(0 To 9, 0 To 9, 0 To 9)...
  • Sub 用vba代码将手动编号和自动编号同时存在的word文档变成全是自动编号的文档()’主程序 Dim n As Integer Dim k As Integer n = ActiveDocument.Paragraphs.Count '判断文章共有几个段落,要注意,最后一个段落很...
  • 以下为代码,采用textbox空间获得输入字符的长度,并通过button_click触发 设置了判断功能,判断当前截取的字符元素长度是否与采集长度一致,如果不一致则舍弃该采集结果,避免存储重复的数据 Sub button_click() ...
  • 关闭输入法及格式化VBA代码工具

    千次阅读 2013-11-18 15:54:11
    关闭输入法及格式化VBA代码工具 运行本程序后, ...2.单击代码, 激活代码窗口后,按F10格式化VBA代码.(类似如Smartindenter 进行缩进排版) (c) horizon_zpy@163.com 2013 下载地址点击打开链接
  • 比如在 Excel 中,批量提取多个工作簿中的数据或写入修改数据自动创建多个数据透视表、图表、形状自动转换成PDF等在 Word 中,你可能会希望批量更换模板批量自动排版在 PowerPoint 中批量更换幻灯片母版自动读取...
  • excel图片排版效果

    2015-02-03 16:28:24
    利用excel对图片进行自动排版后效果,也可以利用vba代码进行排版
  • 在Word中有3个“自动化利器”,分别是域、邮件合并和VBA,本期Word妹与大家简单分享有关域在排版中的实际运用。1、域是什么简单来看看什么是域?一般来讲,在Word中,那些会变化、可更新的就是域,比如插入的时间...
  • VBA常用技巧

    2014-12-21 16:39:28
    技巧189 保护VBA代码 12 189-1 设置工程密码 12 189-2 设置“工程不可查看” 12 技巧190 优化代码 12 190-1 关闭屏幕刷新 12 190-2 使用工作表函数 12 190-3 使用更快的单元格操作方法 12 190-4 使用With语句引用...
  • word 排版神器

    2019-02-27 15:05:20
    小恐龙公文排版助手 for Word ...Microsoft.NET FrameWork 4.0以上(win8.1以上系统自带,其他系统安装程序会自动从微软下载) [1052版本从4.6改为4.0] Word2007和2010需要安装 VS2010 Tool for Office Runtime
  • VBA编程技巧大全

    2013-08-05 09:03:19
    技巧189 保护VBA代码 459 189-1 设置工程密码 459 189-2 设置“工程不可查看” 460 技巧190 优化代码 462 190-1 关闭屏幕刷新 462 190-2 使用工作表函数 464 190-3 使用更快的单元格操作方法 465 190-4 使用With语句...
  • 工程解密功能可以解除VBA工程不可查看的OFFICE工程文档,解除后重新打开文档可100%准确还原源代码,是VBA开发者的必备利器。采用字典补码查漏纠错技术实现台湾繁体系统中繁简转换与GB2BIG5转换准确率达100%,达到微软...
  • 最近经常需要打印文件,但文件字体大,行距大,为了节约打印纸,有必要对文档进行重新排版:最窄布局、无段落空格、行距固定最窄、缩小字体,全部VBA代码: '改变布局 Selection.WholeStory With Selection....
  • excel批量导入图片的方法和例子

    千次阅读 2016-08-15 16:23:36
    内容提要:文章分享了三个excel批量导入... excel批量导入图片一般是使用VBA代码实现,因为excel功能的局限性,插入——图片,尽管可以批量导入图片,但不能自动排版。  文章总结几个excel批量导入图片相关的案例,
  • 工程解密功能可以解除VBA工程不可查看的EXCEL工程文档,解除后重新打开文档可100%准确还原源代码,是VBA开发者的必备利器。采用字典补码查漏纠错技术实现台湾繁体系统中繁简转换与GB2BIG5转换准确率达100%,达到微软...
  • 工程解密功能可以解除VBA工程不可查看的EXCEL工程文档,解除后重新打开文档可100%准确还原源代码,结合Office编程百宝箱成为VBA开发者的必备利器。更内置了比Vlookup()函数更强大且好用的VlookupIn()函数。能对VBA宏程...
  • Excel百宝箱9.0无限制破解版

    热门讨论 2012-02-03 19:05:29
    【批量导入图片(自动排版)】:批量导入图片,且自动排版,可多行多列排版,可任意指定图片大小与路径 【批量导入图片到批注】:批量地将图片导入到批注中,可以自由设定图片显示大小 【删除所有图片】:删除当前表...
  • Excel百宝箱

    2012-10-27 17:09:21
    【批量导入图片(自动排版)】:批量导入图片,且自动排版,可多行多列排版,可任意指定图片大小与路径 【批量导入图片到批注】:批量地将图片导入到批注中,可以自由设定图片显示大小 【删除所有图片】:删除当前表...
  • 工程解密功能可以解除VBA工程不可查看的EXCEL工程文档,解除后重新打开文档可100%准确还原源代码,结合Office编程百宝箱成为VBA开发者的必备利器。更内置了比Vlookup()函数更强大且好用的VlookupIn()函数。能对VBA宏程...

空空如也

空空如也

1 2
收藏数 33
精华内容 13
热门标签
关键字:

vba代码自动排版