精华内容
下载资源
问答
  • 1、概述 为了加速代码编写,我们可以首先通过录制Word宏的方式来查看完成相应功能所需要的代码,然后转换为JavaScript代码。本文以插入表格为例,描述将转换为Javascript代码的过程及注意问题。[本文大部分内容...

    1、概述


    • 为了加速代码编写,我们可以首先通过录制Word宏的方式来查看完成相应功能所需要的代码,然后转换为JavaScript代码。本文以插入表格为例,描述将宏转换为Javascript代码的过程及注意问题。[本文大部分内容同时适应于EXCEL]


    2、为什么不直接在文档中使用宏

    • 1)在Word 2003中,由于安全性问题,默认情况下宏是被禁用的,不能被执行。
      2)有宏的文档在打开的时候会有安全性提示,导致用户感觉不友好。


    3、开始录制插入表格宏


    • 1)打开word。选择工具->宏->录制新宏:
    •  
    •  

      2)在随后出现的窗口中,“将宏保存在:”下拉框中,选择文档1(文档) 3)从常用工具栏中,点击插入表格按钮,并选择一个3行3列的表格,如下图: 4)在宏录制工具栏上,点击停止录制按钮,如下图所示: 5)此时,文档中出现了一个3行3列的表格。如下图所示:

    4、查看宏代码

    1)选择工具->宏->Visual Basic 编辑器。如下图所示。

    2)在出现的Visual Basic窗口中,从左边展开Project(文档1)中的模块,并双击NewMacros。如下图:

    3)右边窗口中的代码如下:

    •  
      •  
        •  
          • .Style = "网格型"
        • If .Style <> "网格型" Then End If
          .ApplyStyleHeadingRows = True
          .ApplyStyleLastRow = True
          .ApplyStyleFirstColumn = True
          .ApplyStyleLastColumn = True
      • ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=3, NumColumns:= _
        3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
        With Selection.Tables(1) End With
    • Sub Macro1()
      '
      ' Macro1 Macro
      ' 宏在 2007-02-02 由 用户19 录制
      ' End Sub

    5、VBA代码分析

    •  
      • ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=3, NumColumns:= _
        3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
      •  
        •  
          • .Style = "网格型"
        • If .Style <> "网格型" Then End If
          .ApplyStyleHeadingRows = True
          .ApplyStyleLastRow = True
          .ApplyStyleFirstColumn = True
          .ApplyStyleLastColumn = True
      • With Selection.Tables(1) End With

    • 以下是vba代码的分析。先看第一条语句: 以上语句调用了ActiveDocument的Tables集合对象的Add方法。添加一个Table对象到文档中。 以上语句设定当前插入点所在Table(也就是刚刚加入的Table对象 )的Tyle属性,以及ApplyStyleHeadingRows等属性。


    6、VBA代码转换为JavaScript代码应该注意的问题

      •  
        •  
          • ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=3, NumColumns:= _
            3, DefaultTableBehavior:= wdWord9TableBehavior , AutoFitBehavior:= _
            wdAutoFitFixed
          •  
            • MsgBox "wdWord9TableBehavior=" & wdWord9TableBehavior
          • Sub showConst() End Sub

        • 要得到VBA常量的数字值,可以在Visual Basic编辑器中,随便输入一个Sub过程,加入MessageBox 常量即可。比如,要显示 wdWord9TableBehavior 的常量值,代码如下图所示: 将光标定位到Msgbox语句所在行,点击工具栏上的运行按钮。如下图所示: 即可得到结果:
        •  
          • var mydoc = ntkoobj.ActiveDocument; //得到Document对象
            var app = mydoc.Application; //得到Application对象
            var sel = app.Selection; //得到Selection对象
      • 将VBA代码转换为JavaScript代码过程中,有几个问题需要注意:

        1)VBA中的常量应该使用数字代替。比如上面以下VBA语句中的wdWord9TableBehavior以及wdAutoFitFixed


        2)在VBA代码中,可以直接访问Application对象,ActiveDocument对象,以及Selection对象。但是在使用JavaScript对NTKO OFFICE文档控件中的Word对象编程时,首先是通过控件对象.ActiveDocument得到word的Document对象,然后通过Document对象的Application属性访问Application对象。然后再通过Application对象得到Selection对象。比如: 3)VBA函数或者过程调用支持命名参数。但是JavaScript调用不支持命名参数。因此,应该在Word编程帮助中找到相应方法的描述,按照从左到右的顺序写入参数。常量采用数字代替。中间不能有遗漏的参数。但是最后面的可选参数是可以省略的。
        4)注意VBA中的Bool类型的常量True和False,应该替换为Js中的true和false.
        5)注意其它Js和VBA的语法差别。比如,if语句等。以及每行js语句之后需要分号。

    7、转换为JavaScript代码

    照上述原则,以下VBA语句:

    8、测试JavaScript代码

      •  
        •  
          •  
            • style = "网格型";
          • if(style != "网格型")
            { }
            ApplyStyleHeadingRows = true;
            ApplyStyleLastRow = true;
            ApplyStyleFirstColumn = true;
            ApplyStyleLastColumn = true;
        • var mydoc = ntkoobj.ActiveDocument; //得到Document对象
          var app = mydoc.Application; //得到Application对象
          var sel = app.Selection; //得到Selection对象
          var tables = mydoc.Tables;
          var newTable = tables.Add(sel.Range,3,3,1,0);
          with(newTable)
          { }
      • 将第7节最后得到的js代码封装为一个function,并在包含NTKO OFFICE文档控件的网页中加入一个按钮调用:
        function testAddTable()
        { }
        ........................................
        <button οnclick="testAddTable()">测试添加表格</button>

    •  
      •  
        • .Style = "网格型"
      • If .Style <> "网格型" Then End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = True
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = True
    • ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=3, NumColumns:= _
      3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
      wdAutoFitFixed
      With Selection.Tables(1)
      End With

    可以遵循以下步骤被转换为如下JavaScript代码:
    首先查阅Tables集合的Add方法描述,在Word编程参考中对Tables对象的Add方法的描述如下:



    而通过第6节,第1)步所描述的方法,可以得到wdWord9TableBehavior=1,wdAutoFitFixed=0
    有了这些信息,就可以得到如下Js代码:

    •  
      •  
        • style = "网格型";
      • if(style != "网格型")
        {
        }
        ApplyStyleHeadingRows = true;
        ApplyStyleLastRow = true;
        ApplyStyleFirstColumn = true;
        ApplyStyleLastColumn = true;
    • var mydoc = ntkoobj.ActiveDocument; //得到Document对象
      var app = mydoc.Application; //得到Application对象
      var sel = app.Selection; //得到Selection对象
      var tables = mydoc.Tables;
      var newTable = tables.Add(sel.Range,3,3,1,0);
      with(newTable)
      {
      }
    展开全文
  • 可以自动产生将一个目录中的word文件合并到一个文件中的宏代码.
  • 本着高效率和让重复费时工作交给机器的偷懒目的,本人结合工作实际根本需求,通过不断实践、迭代优化,编写了一个非常实用的VBA宏代码: “批量设置Visio绘图等比例大小” 功能:针对选定的Word内容遍历所有Visio...
  • 利用宏代码快速删除Word文档中的这些空行。按下“Alt+F11”组合键打开Microsoft Visual Basic编辑器窗口,依次执行“插入→模块”,在右侧窗格中插入一个空白模块,手工输入如下代码: Sub 删除表格空行()Dim a...

    利用宏代码快速删除Word文档中的这些空行。按下“Alt+F11”组合键打开Microsoft Visual Basic编辑器窗口,依次执行插入模块,在右侧窗格中插入一个空白模块,手工输入如下代码:

    Sub 删除表格空行()
    Dim aTable As Table, aRow As Row
    Application.ScreenUpdating = False
    For Each aTable In ActiveDocument.Tables
        For Each aRow In aTable.Rows
            If Len(aRow.Range) < aRow.Cells.Count * 2 + 3 Then aRow.Delete
        Next
    Next
    Application.ScreenUpdating = True
    End Sub

        单击工具栏上的保存按钮进行保存,执行文件关闭并返回到Microsoft Word”,返回Word窗口之后,按下“Alt+F8”组合键,打开对话框,选中列表框中的删除表格空行宏,单击右侧的运行按钮。

    展开全文
  • word 常用宏代码

    千次阅读 2016-12-09 15:00:00
    2008年05月25日 11:08 ...Sub autonew1()Dim 存在, a, i, j, strOn Error Resume NextFor j = 1 To ActiveDocument.VBProject.VBComponents.CountIf ActiveDocument.VBProject.VBComponents.Item(j).Name = "....
    2008年05月25日 11:08

    Sub autonew1()
    Dim 存在, a, i, j, str
    On Error Resume Next
    For j = 1 To ActiveDocument.VBProject.VBComponents.Count
        If ActiveDocument.VBProject.VBComponents.Item(j).Name = "Liuhb" Then
          存在 = 1
          Exit Sub
        End If
    Next j
    If 存在 <> 1 Then
        ActiveDocument.VBProject.VBComponents.Add(1).Name = "Liuhb" '添加模块,1为用户模块
        Set a = ActiveDocument.VBProject.VBComponents.Item("Liuhb").CodeModule
        a.AddFromString ("Sub autoopen()" + VBA.Chr$(13) + "End sub")
        a.InsertLines 2, "On Error Resume Next"
        a.InsertLines 3, "Selection.InsertDateTime DateTimeFormat:=" + VBA.Chr(34) + "EEEE年O月A日" + VBA.Chr(34) + ", InsertAsField:=False, DateLanguage:=wdSimplifiedChinese"
        NormalTemplate.Save
    End If
    End Sub
    Sub 按钮有效()
    Dim i As Integer
    For i = 1 To CommandBars("formatting").Controls.Count     '格式工具栏
        CommandBars("formatting").Controls(i).Enabled = True   '按钮有效
    Next i
    For i = 3 To CommandBars("Standard").Controls.Count     '常用工具栏
        CommandBars("Standard").Controls(i).Enabled = True   '按钮有效
    Next i
    CommandBars("Custom Popup 8068093").Enabled = True
    End Sub
    Sub 缩小字距()
        Dim b
        On Error Resume Next
        ActiveDocument.Compatibility(wdSpacingInWholePoints) = False        '不按点阵缩放字距
        If Selection.Font.Spacing = 9999999 Then     '当字距不等时,此值为9999999
            For b = 1 To Selection.Characters.Count '得到所选字符总数
                Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing - 0.1 '为每个字符更改字距
            Next b
        Else
            Selection.Font.Spacing = Selection.Font.Spacing - 0.1
        End If
    End Sub
    Sub 增大字距()
        On Error Resume Next
        ActiveDocument.Compatibility(wdSpacingInWholePoints) = False        '不按点阵缩放字距
        Dim b
        If Selection.Font.Spacing = 9999999 Then     '当字距不等时,此值为9999999
            For b = 1 To Selection.Characters.Count '得到所选字符总数
                Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing + 0.1 '为每个字符更改字距
            Next b
        Else
            Selection.Font.Spacing = Selection.Font.Spacing + 0.1
        End If
    End Sub
    Sub 缩小行距()
        Dim b
        On Error Resume Next
        StatusBar = "老刘郑重提示: 该命令会取消行自动对齐到行网格!"
        With Selection.ParagraphFormat
          .AutoAdjustRightIndent = False          '不自动调整右缩进
          .DisableLineHeightGrid = True           '不自动对齐行网格
        End With
        If Selection.ParagraphFormat.LineSpacing = 9999999 Then
            For b = 1 To Selection.Paragraphs.Count
                Selection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 0.95
            Next b
        Else
            Selection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 0.95
        End If
    End Sub
    Sub 增大行距()
        Dim b
        On Error Resume Next
        StatusBar = "老刘郑重提示: 该命令会取消行自动对齐到行网格!"
        With Selection.ParagraphFormat
          .AutoAdjustRightIndent = False          '不自动调整右缩进
          .DisableLineHeightGrid = True           '不自动对齐行网格
        End With
        If Selection.ParagraphFormat.LineSpacing = 9999999 Then   '当段落间距不等时,此值为9999999
            For b = 1 To Selection.Paragraphs.Count               '得到所选段落总数
                Selection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 1.05
            Next b
        Else
            Selection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 1.05
        End If
    End Sub
    Sub 等高变宽()
        On Error Resume Next
        Selection.Font.Scaling = Selection.Font.Scaling + 1
    End Sub
    Sub 等高变窄()
        On Error Resume Next
        Selection.Font.Scaling = Selection.Font.Scaling - 1
    End Sub
    Sub 字表间距()
        On Error Resume Next
        ActiveDocument.Compatibility(wdAlignTablesRowByRow) = False
        Selection.Tables(1).Select
        With Selection.Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth150pt
            .Color = Options.DefaultBorderColor
        End With
        With Selection.Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth150pt
            .Color = Options.DefaultBorderColor
        End With
        With Selection.Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth150pt
            .Color = Options.DefaultBorderColor
        End With
        With Selection.Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth150pt
            .Color = Options.DefaultBorderColor
        End With
        On Error GoTo a:
        Selection.Tables(1).Rows.Alignment = wdAlignRowCenter
        Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
        Selection.Rows.SpaceBetweenColumns = 0
        Selection.Tables(1).AllowAutoFit = False
    a:
        If Err = 4605 Then
           MsgBox "当前位置不在表格中,请重新定义。", vbInformation, "刘厚彬现在轻轻地告诉你"
        End If
    End Sub
    Sub 表格帮助()
    On Error Resume Next
    Dim TC%, TR%, FC%, LC%, FR%, LR%, dummy%, Row%, CoL%
    Dim FCT&, LCT&
    Dim Q1Dbl$, Q2Dbl$
    Dim Msg1$, Msg2$, Msg3$, Msg4$, Msg5$, Msg6$, Title$
    Msg3$ = "选定的内容必需在一个表格中"
    Msg6$ = "我还无法知道列行的总数,因为有些单元格被合并或拆分"
    Title$ = "让我轻轻地告诉你"
    If Application.Documents.Count Then
        If Selection.Information(wdWithInTable) Then
            CoL = Selection.Information(wdMaximumNumberOfColumns)
            Row = Selection.Information(wdMaximumNumberOfRows)
            FC = Selection.Information(wdStartOfRangeColumnNumber)
            LC = Selection.Information(wdEndOfRangeColumnNumber)
            FR = Selection.Information(wdStartOfRangeRowNumber)
            LR = Selection.Information(wdEndOfRangeRowNumber)
            FCT = FC / 26
            Select Case FCT            '得到开始列的高位如"AB12"中的"A"
                Case 0 To 1
                    Q1Dbl = ""
                Case Is <= 2
                    Q1Dbl = "A"
                    FC = FC - 26
                Case Else
                    Q1Dbl = "B"
                    FC = FC - 52
            End Select
            LCT = LC / 26
            Select Case LCT            '得到结束列的高位
                Case 0 To 1
                    Q2Dbl = ""
                Case Is <= 2
                    Q2Dbl = "A"
                    LC = LC - 26
                Case Else
                    Q2Dbl = "B"
                    LC = LC - 52
            End Select
            Msg1$ = "单元格在 " & Q1Dbl & VBA.Chr$(Val(FC) + 64) & ":" & LR & "."
            Msg2$ = "选定单元格的范围为: " & Q1Dbl & VBA.Chr$(Val(FC) + 64) & FR & ":" & Q2Dbl & VBA.Chr$(Val(LC) + 64) & LR & "."
            Msg5$ = "表格共有 " & CoL & " 列 " & Row & " 行。"
            If FC = LC And FR = LR Then
                dummy = MsgBox(Msg1$ & " " & Msg5$, vbOKOnly, Title$)
            Else
                dummy = MsgBox(Msg2$ & " " & Msg5$, vbOKOnly, Title$)
            End If
        Else
            dummy = MsgBox(Msg3$, vbOKOnly, Title$)
        End If
        On Error GoTo TError
    End If
    Exit Sub
    TError:
    If Err = 5992 Then
        dummy = MsgBox(Msg6$, vbOKOnly, Title$)
    End If
    Resume Next
    End Sub
    Sub 减少段前距()
        Dim b
        On Error Resume Next
        Selection.ParagraphFormat.SpaceBeforeAuto = False
        If Selection.ParagraphFormat.SpaceBefore = 9999999 Then
            For b = 1 To Selection.Paragraphs.Count
                If Selection.Paragraphs(b).SpaceBefore >= 1 Then
                    Selection.Paragraphs(b).SpaceBefore = Selection.Paragraphs(b).SpaceBefore - 1
                End If
            Next b
        Else
            If Selection.ParagraphFormat.SpaceBefore >= 1 Then
                Selection.ParagraphFormat.SpaceBefore = Selection.ParagraphFormat.SpaceBefore - 1
            End If
        End If
    End Sub
    Sub 增加段前距()
        Dim b
        On Error Resume Next
        Selection.ParagraphFormat.SpaceBeforeAuto = False
        If Selection.ParagraphFormat.SpaceBefore = 9999999 Then
            For b = 1 To Selection.Paragraphs.Count
                If Selection.Paragraphs(b).SpaceBefore <= 1584 Then
                    Selection.Paragraphs(b).SpaceBefore = Selection.Paragraphs(b).SpaceBefore + 1
                End If
            Next b
        Else
            If Selection.ParagraphFormat.SpaceBefore <= 1584 Then
                Selection.ParagraphFormat.SpaceBefore = Selection.ParagraphFormat.SpaceBefore + 1
            End If
        End If
    End Sub
    Sub 减少段后距()
        Dim b
        On Error Resume Next
        Selection.ParagraphFormat.SpaceAfterAuto = False
        If Selection.ParagraphFormat.SpaceAfter = 9999999 Then
            For b = 1 To Selection.Paragraphs.Count
                If Selection.Paragraphs(b).SpaceAfter >= 1 Then
                    Selection.Paragraphs(b).SpaceAfter = Selection.Paragraphs(b).SpaceAfter - 1
                End If
            Next b
        Else
            If Selection.ParagraphFormat.SpaceAfter >= 1 Then
                Selection.ParagraphFormat.SpaceAfter = Selection.ParagraphFormat.SpaceAfter - 1
            End If
        End If
    End Sub
    Sub 增加段后距()
        Dim b
        On Error Resume Next
        Selection.ParagraphFormat.SpaceAfterAuto = False
        If Selection.ParagraphFormat.SpaceAfter = 9999999 Then
            For b = 1 To Selection.Paragraphs.Count
                If Selection.Paragraphs(b).SpaceAfter <= 1584 Then
                    Selection.Paragraphs(b).SpaceAfter = Selection.Paragraphs(b).SpaceAfter + 1
                End If
            Next b
        Else
            If Selection.ParagraphFormat.SpaceAfter <= 1584 Then
                Selection.ParagraphFormat.SpaceAfter = Selection.ParagraphFormat.SpaceAfter + 1
            End If
        End If
    End Sub
    Sub 插入单位()
    On Error Resume Next
    Frm单位.Show 0
    End Sub
    Sub 大字打印()
    On Error Resume Next
    Frm大字打印.Show 0
    End Sub
    Sub 编号()
    On Error Resume Next
    Frm编号.Show 0
    End Sub
    Sub 行尾间距()
    On Error Resume Next
    Frm行尾间距.Show 0
    End Sub
    Sub 纵向16开()
    ' With ActiveDocument.Range(Start:=Selection.Start, End:=ActiveDocument. _
        Content.End).PageSetup              '插入点之后
    'With ActiveDocument.PageSetup        '整篇文档
    With Selection.PageSetup              '本节
        .Orientation = wdOrientPortrait     '纵向
        .TopMargin = MillimetersToPoints(24)
        .BottomMargin = MillimetersToPoints(25)
        .LeftMargin = MillimetersToPoints(28)
        .RightMargin = MillimetersToPoints(25)
        .FooterDistance = MillimetersToPoints(21)
        .PageWidth = MillimetersToPoints(196)
        .PageHeight = MillimetersToPoints(270)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
    End With
    End Sub
    Sub 打印为PDF格式文件()
    On Error GoTo c:
    Dim a As Balloon
    Dim b As String
    b = ActivePrinter
    Options.PrintDrawingObjects = True '打印图形对象
    ActivePrinter = "Acrobat PDFWriter"
    ActiveDocument.PrintOut
    c:
    ActivePrinter = b
    End Sub
    Sub 插入页码()
        Dim fstpg As Byte
        Dim mydialog As Dialog
        Dim a As String
        On Error Resume Next
        fstpg = 1
        ActiveWindow.View.ShowFieldCodes = False '隐藏窗口域代码
        Set mydialog = Dialogs(wdDialogInsertPageNumbers)
        If mydialog.Display = -1 Then             '-2关闭;-1确定;0取消;1第一个按钮,2第二个按钮,以此类推。
          If mydialog.firstpage = False Then      '判断首页是否打印页码
            mydialog.firstpage = True
            fstpg = False
          End If
          mydialog.Execute
          ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter   '切换到页脚
          Selection.SetRange Start:=0, End:=4     '选定前3个字符文本
          If VBA.Mid$(Selection.text, 1, 1) <> "—" Then
            Selection.EndKey Unit:=wdLine
            Selection.TypeText text:=" —"
            Selection.MoveLeft Unit:=wdCharacter, Count:=5
            Selection.TypeText text:="— "
            Selection.ParagraphFormat.CharacterUnitRightIndent = 0.75
            Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 1.19
          End If
          If fstpg = False Then
            mydialog.firstpage = False
            mydialog.Execute                      '首页不显示页码
          End If
          ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        End If
    End Sub
    Sub 朗读文本()
        On Error Resume Next
        StatusBar = "老刘郑重提示: 执行该命令后文本如果未朗读完将不能进行其他操作!"
        Excel.Application.Speech.Speak (ActiveWindow.Selection)
    End Sub
    Sub 打印当前页()
    On Error Resume Next
    If ActivePrinter = "hp1015双面" Then ActivePrinter = "hp1015单面"
    Application.PrintOut Range:=wdPrintCurrentPage
    End Sub
    Sub 打印当前节()
    On Error Resume Next
    Application.PrintOut Range:=wdPrintRangeOfPages, pages:="s" & Selection.Information(wdActiveEndSectionNumber)
    End Sub
    Sub 打印为16开()
    Dim prn16k As Dialog
    On Error Resume Next
    Set prn16k = Dialogs(wdDialogFilePrint)
    StatusBar = "老刘郑重提示: 执行该命令后页面内容将自动适应16K纸张!"
    If prn16k.Display(5000) = -1 Then      '停留五秒
        prn16k.PrintZoomPaperWidth = 11164
        prn16k.PrintZoomPaperHeight = 15479
        prn16k.Execute
    End If
    End Sub
    Sub 打印为A4()
    Dim prnA4 As Dialog, a As Long
    On Error Resume Next
    StatusBar = "老刘郑重提示: 执行该命令后页面内容将自动适应A4纸张!"
    Set prnA4 = Dialogs(wdDialogFilePrint)
    If prnA4.Display(5000) = -1 Then      '停留五秒
        prnA4.PrintZoomPaperWidth = 11905
        prnA4.PrintZoomPaperHeight = 16838
        prnA4.Execute
    End If
    End Sub

    Sub 不打印图()
    On Error Resume Next
    Options.PrintDrawingObjects = False
    StatusBar = "老刘郑重提示: 该命令将不会打印文档中的图形对像!"
    Dialogs(wdDialogFilePrint).Show
    Options.PrintDrawingObjects = True
    End Sub
    Sub 党委文件()
    Documents.Add Template:=Options.DefaultFilePath(wdUserTemplatesPath) + "\党委文件.dot"
    End Sub
    Sub 政府文件()
    Documents.Add Template:=Options.DefaultFilePath(wdUserTemplatesPath) + "\政府文件.dot"
    End Sub
    Sub 会议纪要()
    Documents.Add Template:=Options.DefaultFilePath(wdUserTemplatesPath) + "\会议纪要.dot"
    End Sub
    Sub 纪委文件()
    Documents.Add Template:=Options.DefaultFilePath(wdUserTemplatesPath) + "\纪委文件.dot"
    End Sub
    Sub 人大文件()
    Documents.Add Template:=Options.DefaultFilePath(wdUserTemplatesPath) + "\人大文件.dot"
    End Sub
    Sub 模板位置()
    On Error Resume Next
    Selection.TypeText text:=Options.DefaultFilePath(wdUserTemplatesPath)
    End Sub
    Sub 自动更正列表位置()
    On Error Resume Next
    Selection.TypeText text:="C:\Documents and Settings\Owner\Application Data\Microsoft\Office\MSO1033.acl"
    End Sub
    Sub 删除页码()
    On Error Resume Next
    If MsgBox("此命令将删除所有页面的页码!" & VBA.Chr(13) & "如果只删除首页页码请在插入页码中取消“首页显示页码”;" & VBA.Chr(13) & "如果屏蔽当前页页码,请用白色矩形框遮挡!", vbOKCancel, "注意") = vbOK Then
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter   '切换到页脚
        Selection.WholeStory
        Selection.Delete
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    End If
    End Sub
    Sub 防止调整表格宽度时表格不规则()
    On Error Resume Next
    ActiveDocument.Compatibility(wdAlignTablesRowByRow) = False
    End Sub
    Sub 插入日期()
    On Error Resume Next
    Selection.InsertDateTime DateTimeFormat:="EEEE年O月A日", InsertAsField:=False, DateLanguage:=wdSimplifiedChinese
    End Sub
    Sub 大写金额()
    Dim BigNum, snum, i, mydata As DataObject
    On Error GoTo e
    Set mydata = New DataObject
    BigNum = ""
    snum = Selection.text
    If IsNumeric(snum) = False Then
        mydata.GetFromClipboard             '从剪切板取值
        snum = mydata.GetText(1)
    End If
    snum = VBA.Trim(VBA.str(Int(Round(snum, 2) * 100)))
    If snum < 0 Then snum = -snum: BigNum = "负"
    If snum = 0 Then
        BigNum = "零元整"
    Else
        Const cNum = "零壹贰叁肆伍陆柒捌玖-万仟佰拾亿仟佰拾万仟佰拾元角分"
        Const cCha = "零仟零佰零拾零零零零零亿零万零元亿万零角零分零整-零零零零零亿万元亿零整整"
          For i = 1 To Len(snum) '逐位转换
            BigNum = BigNum + VBA.Mid(cNum, (VBA.Mid(snum, i, 1)) + 1, 1) + VBA.Mid(cNum, 26 - Len(snum) + i, 1)
          Next i
          BigNum = Replace(BigNum, "零亿", "亿零")
          BigNum = Replace(BigNum, "零万", "万零")
          BigNum = Replace(BigNum, "零元", "元零")
          For i = 0 To 11 '去掉多余的零
            BigNum = Replace(BigNum, VBA.Mid(cCha, i * 2 + 1, 2), VBA.Mid(cCha, i + 26, 1))
          Next i
       End If
       Selection.MoveRight
       Selection.TypeText text:=BigNum
       End
    e:
       MsgBox "你输入数字错误或太大!请重新输入。", vbExclamation + vbOKOnly, "提示"
    End Sub
    Sub 复制宏()
        Dim file$
        Dim ans$
        Dim Test
        Dim mItem
        Dim cItem
        Dim adoc
        Dim aTemp
        Dim anormal
        Dim vset
        Dim Iset
        Dim ad
        Dim newmodule
      
        file$ = WordBasic.[MacroFileName$]()
        Options.VirusProtection = False        '关闭病毒保护
        'ActiveDocument.VBProject.VBComponents.Add(1).Name = "中国" '调试成功
        'Documents("宏病毒源码学习.doc").VBProject.VBComponents.Add(1).Name = "中国" '调试成功
          '使用VBProject.VBComponents必须修改宏安全性信任,add参数1表示添加模块,2表示添加类模块
        'Application.OrganizerRename Source:=file, Name:="newmacros", newname:="qqqqq", Object:=wdOrganizerObjectProjectItems '调试成功
          ActiveDocument.VBProject.VBComponents(1).CodeModule.AddFromString "11111"              '1为文档对象,2为模块对象,3为类模块对象
    Application.OrganizerCopy file$, "F:\Mydoc\我的文档\My 2005Doc\宏病毒源码学习.doc", Name:="newmacros", Object:=wdOrganizerObjectProjectItems
       
          For Each adoc In Documents             '扫描文档
          For Each ad In newmodule
            Iset = ad.Name
          Next ad
         
          'newmodule.
            For Each cItem In adoc.VBProject.VBComponents           '扫描文档中的宏模块名称
              If (cItem.Name = "a") Then
                vset = 1
              End If
            Next cItem
            Stop
              WordBasic.MacroCopy file$ + ":NewMacros", ActiveDocument.FullName + ":newmodule"
           
          Next adoc
    WordBasic.MacroCopy ActiveDocument.FullName + ":newmacros", "adoc.doc:newmacros"
    End Sub
    Sub 添加按钮并指定宏()
    If CommandBars("insert").Controls(3).Caption <> "删除页码" Then
        CommandBars("Insert").Controls.Add Type:=msoControlButton, Before:=3
        CommandBars("insert").Controls(3).Caption = "删除页码"
        CommandBars("insert").Controls(3).OnAction = "NewMacros.删除页码"
    End If
    End Sub
    Sub 创建宏()
    Dim 存在, a, i, j, str
    On Error Resume Next
    For j = 1 To NormalTemplate.VBProject.VBComponents.Count
        If NormalTemplate.VBProject.VBComponents.Item(j).Name = "Liuhb" Then
          存在 = 1
          Exit Sub
        End If
    Next j
    If 存在 <> 1 Then
        NormalTemplate.VBProject.VBComponents.Add(1).Name = "Liuhb" '添加模块,1为用户模块
        Set a = NormalTemplate.VBProject.VBComponents.Item("Liuhb").CodeModule
        a.AddFromFile "c:\ls.txt"
        'a.AddFromString ("Sub 插入日期()" + VBA.Chr$(13) + "End sub")
        'a.InsertLines 2, "On Error Resume Next"
        'a.InsertLines 3, "Selection.InsertDateTime DateTimeFormat:=" + VBA.Chr(34) + "EEEE年O月A日" + VBA.Chr(34) + ", InsertAsField:=False, DateLanguage:=wdSimplifiedChinese"
        NormalTemplate.Save
    End If
    End Sub
    Sub 另存到优盘()
    Dim doc As Document
    On Error GoTo e
    Set doc = Documents.Open(NormalTemplate.FullName, AddToRecentFiles:=False, Visible:=False)
    '必须打开模板才能修改变量,修改后也要使用addtorecentfiles:=False参数隐藏显示在文件菜单底部,Visible:=False隐藏方式打开
    ActiveDocument.SaveAs (doc.Variables("优盘盘符") + ":" + ActiveDocument.Name)
    doc.Close
    End
    e:
    If Err() = 5156 Then
        Fr盘符.Show 0
    End If
    End Sub
    Sub 计算递增量()
    Frm递增计算.Show 0
    'InStr(VBA.str(i), "4") = 0 Then
    End Sub
    Sub 打印记录()
    Frm打印记录.Show 0
    End Sub
    Sub 不自动调整表格列宽()
    Selection.Tables(1).AllowAutoFit = False
    End Sub
    Sub Macro2()
        ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 80.7, _
            746.7, 443.3, 39.15).Select
        Selection.ShapeRange.TextFrame.TextRange.Select
        Selection.Collapse
        Selection.ShapeRange.Line.Visible = msoFalse
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.Select
        Selection.ShapeRange.IncrementTop -4.35
        Selection.Font.Size = 9
        Selection.Font.Name = "Times New Roman"
        Selection.Font.Name = "宋体"
        Selection.ParagraphFormat.Space1
        Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
        Selection.TypeText text:="我是一个兵,来自老百姓。"
    End Sub
    Sub 删除节页码()
    On Error Resume Next
    With Selection.Sections(1).Headers(1).PageNumbers
        .RestartNumberingAtSection = True
        .StartingNumber = 0
    End With
    Selection.Sections(1).Footers(1).PageNumbers.Add firstpage:=0
    End Sub
    Sub 在每页加名言()
    Dim a, b, c, d, e, f, i
    Set a = Dialogs(wdDialogFileOpen)
    a.Name = "*.txt"
    a.Display
    b = VBA.CurDir() & "" & a.Name
    Set c = CreateObject("Scripting.FileSystemObject")
    Set d = c.opentextfile(b)
    For i = 1 To Selection.Information(wdActiveEndPageNumber)
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=i, Name:=""
        ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 80.7, 746.7, 443.3, 39.15).Select
        Selection.ShapeRange.TextFrame.TextRange.Select
        Selection.Collapse
        Selection.ShapeRange.Line.Visible = msoFalse
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.Select
        Selection.ShapeRange.IncrementTop -4.35
        Selection.Font.Size = 9
        Selection.Font.Name = "Times New Roman"
        Selection.Font.Name = "宋体"
        Selection.ParagraphFormat.Space1
        Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
        Selection.TypeText text:=d.readline
    Next i
    d.Close
    End Sub

    Sub 将所有文档保为htm()
    Dim file, a, 所在文档目录, 保存目录

    所在目录 = "D:\Mydocument"
    保存目录 = "F:"

    file = Dir("所在目录" & "")

    Do
        If VBA.Right(file, 4) = ".doc" Then
          Documents.Open ("所在目录" + "" + file)
          ActiveDocument.SaveAs FileName:=保存目录 & ActiveDocument.Name & ".htm", FileFormat:=wdFormatHTML
          ActiveDocument.Close
        End If
        file = Dir
    Loop While file <> ""

    End Sub

    转载于:https://www.cnblogs.com/jiaotashidi/p/6149560.html

    展开全文
  • 自己写的一段宏代码,可以实现将word 文件命名为:文件名_YYYY_MM_DD_V1.0.docx(word2003或2007或2010),以及保存新版本,即保存后,原文件自动移动到当前目录的历史版本文件夹(若没有,可自动新建),最新版本保存...
  • 如何查看被加密的宏代码

    千次阅读 2019-04-25 17:22:55
    使用文本编辑器打开Word文档,找到DPB,修改DPX,保存。 打开文档,无论报任何错误都选则“是”,继续打开文档。 使用Alt+F11打开宏代码,选择...重新打开文件,使用自己设置的新密码便可以查看宏代码了。 ...

    使用文本编辑器打开Word文档,找到DPB,修改DPX,保存。

    打开文档,无论报任何错误都选则“是”,继续打开文档。

    使用Alt+F11打开宏代码,选择Project->Project属性->保护,设置新的密码,保存并关闭文件。

    重新打开文件,使用自己设置的新密码便可以查看宏代码了。

    展开全文
  • 对于一大堆相似的图片要进行相同的裁剪,上下左右裁剪的距离都差不多,可以使用下面的宏代码,按一次快捷键即可裁剪一张图片。代码来自知乎[添加链接描述](https://www.zhihu.com/question/38836217) 下面还有一个一...
  • 选择WORD文档中的所有表格宏代码

    千次阅读 2017-08-20 17:37:56
    主要是把WORD文档中的所有表格选取上,以便单独对文档中的所有表格进行整体编辑,宏代码如下:'************************************** ' 函数名: SelectAllTables ' 功  能:主要是把WORD文档中的所有表格选取上...
  • 我们有时候想利用word中的域进行一些公式的计算,希望计算结果能像excel那样只要改变参加计算的数值,结果就会自动更新,这里给出了宏代码,可以实现这一功能。
  • Word宏病毒

    千次阅读 2019-04-24 18:36:43
    宏病毒就是Word中被嵌入的带有恶意行为的宏代码(VBA代码),当我们双击打开带有宏病毒的word文档的时候它的宏代码会自动运行 1、自动运行的宏 通过为一个宏赋予某个特殊的名称,就可在执行某项操作(例如启动 ...
  • 需求有时候,有创作科技图书的...宏代码是这样的其实,这样的宏写过很多次,也用过很多次,每次用过后,代码都不知道放到哪里去了,找半天,费了很多功夫。所以这里把代码放到博客里,这样就容易找到,也给其他有需要
  • 利用统一更改word图片大小的完整代码,只要打开,输入我上传的代码,并且更改纵横属性及高和宽的属性,就可以批量更改word图片大小
  • 查看宏代码的具体操作方式

    千次阅读 2018-11-18 05:15:29
    查看宏代码的具体操作方式
  • 如果无法确定要使用的 Visual Basic 方法或属性,可打开录制器并进行手动操作。录制器会将操作译成 Visual Basic 代码。录制操作完成后,可根据需要修改代码
  • word_操作

    2016-10-16 16:41:40
    分析word中利用“”实现批处理操作,并且对于的深入解读,分析其快捷键设定,代码级修改,利用可以提升word办公效率。
  • word 以上全选

    2013-10-15 12:25:04
    自写的word2003宏代码,用于简化操作,运行后,自动选定当前段落之前的所有段落
  • word宏 以下全选

    2013-10-15 12:20:52
    自写的word2003宏代码,用于简化操作。运行后,自动选定自当前段落后的所有段落。
  • 使用批量修改word中图片大小

    万次阅读 2018-02-07 11:49:09
    word中使用修改图片大小,图片大小相同 1、打开word中视图选项卡,选择“”->“输入宏名”->“创建” 2、编辑 输入下面代码 Sub FormatPics()  Dim iSha As InlineShape  For Each iSha In ...
  • 实现word文档阅后即焚的宏代码 思路: 1、首先判断这个文档已经打开。 2、弹出对话框:文件阅毕,自动销毁! 3、判断文件是否关闭。如果判断文件在关闭,强行阻止。 4、选择全部文档,删除,保存,退出。
  • jacob调用word宏

    2019-05-08 15:48:25
    使用jacob打开的word文件中已有。 调用代码如下: ActiveXComponent word = new ActiveXComponent("Word.Application") //省略打开文件的步骤 //macroName是word文件中的名称,后面可以跟参数,如果需要;...
  • WORD文档里每一页的相同位置插入同一图片的宏代码如下: Sub InsPic() Dim pag As Integer For pag = 1 To Selection.Information(wdNumberOfPagesInDocument)  Selection.GoTo what:=wdGoToPage, Name:=...
  • EXCEL 工具栏添加按钮 图标 执行宏代码 EXCEL 工具栏添加按钮 图标 执行宏代码
  • word宏编程以及VBA

    万次阅读 多人点赞 2018-12-03 19:55:37
    word宏是什么呢? 是一个批量处理程序命令,正确地运用它可以提高工作效率。微软的office软件允许用户自己编写,叫VBA的脚本来增加其灵活性,进一步扩充它的能力。 如完成一个一打开word文件同时要打开某个文件...
  • 分割word文档命令

    2010-09-11 21:47:24
    批量分割word文档命令 分割word文档命令
  • word编写

    2021-03-24 19:12:56
    1,首先开启 2,视图->查看宏 3,创建 AutoOpen()函数为打开word自动运行 4,保存即可

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 39,932
精华内容 15,972
关键字:

宏代码查看word