Word Vba | ExcelOffice

如何在word中使用DocVariable域显示文档变量的值？

2018年9月25日作者：exceloffice

暂无评论

DocVariable域可以显示通过vba添加给文档的文档变量的值。

DocVariable域的语法如下：

{ DOCVARIABLE "Name" }

1	{ DOCVARIABLE "Name" }

其中Name属性为文档变量的名称。

在word vba中 Document对象具有Variables属性，通过[……]

阅读全文

如何用vba将同一文件下的所有03版本的word转换为最新版本？

2018年9月20日作者：exceloffice

暂无评论

如果要将03版本的word转换为最新的word版本，可以使用Document对象的SaveAs2方法。

代码如下：

Dim oWord As Object
Dim oDic As Object
Const wdExportFormatPDF = 17
Sub QQ1722187970()
   Set oWord = VBA.CreateObject("word.application")
    Dim sPath As String
    '获取文件或者文件夹的路径
    sPath = GetPath()
    If Len(sPath) Then
        EnuAllFiles (sPath)
        MsgBox "处理完成!!!"
    End If
    oWord.Quit
    Set oWord = Nothing
End Sub
Function GetPath() As String
    '声明一个FileDialog对象变量
    Dim oFD As FileDialog
'    '创建一个选择文件对话框
'    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    '创建一个选择文件夹对话框
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    '声明一个变量用来存储选择的文件名
    Dim vrtSelectedItem As Variant
    With oFD
        '允许选择多个文件
        .AllowMultiSelect = True
        '使用Show方法显示对话框，如果单击了确定按钮则返回-1。
        If .Show = -1 Then
            '遍历所有选择的文件
            For Each vrtSelectedItem In .SelectedItems
                '获取所有选择的文件的完整路径,用于各种操作
                GetPath = vrtSelectedItem
            Next
            '如果单击了取消按钮则返回0
        Else
        End If
    End With
    '释放对象变量
    Set oFD = Nothing
End Function
Function GetFileName(ByVal sName As String)
    '获取纯文件名的自定义函数
    'QQ1722187970
    Dim sTemp As String
    sTemp = sName
    '判断后缀名分隔符.的位置
    iPos = Len(sTemp) - VBA.InStr(1, VBA.StrReverse(sTemp), ".")
    If iPos <> 0 Then
        sTemp = Mid(sTemp, 1, iPos)
    End If
    '判断路径分隔符\的位置
    iPos = VBA.InStr(1, sTemp, "\")
    If iPos <> 0 Then
        '反转后好取字符
        iPos = VBA.InStr(1, VBA.StrReverse(sTemp), "\")
        sTemp = Mid(VBA.StrReverse(sTemp), 1, iPos - 1)
        sTemp = VBA.StrReverse(sTemp)
    End If
    GetFileName = sTemp
End Function

Sub EnuAllFiles(ByVal sPath As String, Optional bEnuSub As Boolean = False)
    '定义文件系统对象
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    '定义文件夹对象
    Dim oFolder As Object
    Set oFolder = oFso.GetFolder(sPath)
    '定义文件对象
    Dim oFile As Object
    '如果指定的文件夹含有文件
    If oFolder.Files.Count Then
        For Each oFile In oFolder.Files
            With oFile
                '输出文件所在的盘符
                Dim sDrive As String
                sDrive = .Drive
                '输出文件的类型
                Dim sType As String
                sType = .Type
                '输出含后缀名的文件名称
                Dim sName As String
                sName = .Name
                '输出含文件名的完整路径
                Dim sFilePath As String
                sFilePath = .Path
                '如果文件是Word文件且不是隐藏文件
                If sType Like "*ord*2003*" And Not (sName Like "*~$*") Then
                    Const wdFormatDocumentDefault = 16
                    Const wdFormatXMLDocument = 12
                    Const wdWord2013 = 15
                    Set oDoc = oWord.documents.Open(sFilePath)
                    With oDoc
                        Dim sFPath As String
                        sFPath = .Path
                        sName = .Name
                        sName = GetFileName(sName)
                        sName = sFPath & "\" & sName & ".docx"
                        .SaveAs2 Filename:=sName, FileFormat:=wdFormatDocumentDefault, CompatibilityMode:=wdWord2013
                        .Close
                    End With
                End If
            End With
        Next
    '如果指定的文件夹不含有文件
    Else
    End If
    '如果要遍历子文件夹
    If bEnuSub = True Then
        '定义子文件夹集合对象
        Dim oSubFolders As Object
        Set oSubFolders = oFolder.SubFolders
        If oSubFolders.Count > 0 Then
            For Each oTempFolder In oSubFolders
                sTempPath = oTempFolder.Path
                Call EnuAllFiles(sTempPath, True)
            Next
        End If
        Set oSubFolders = Nothing
    End If
    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFso = Nothing
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

91

92

93

94

95

96

97

98

99

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

Dim oWord As Object

Dim oDic As Object

Const wdExportFormatPDF = 17

Sub QQ1722187970()

Set oWord = VBA.CreateObject("word.application")

Dim sPath As String

'获取文件或者文件夹的路径

sPath = GetPath()

If Len(sPath) Then

EnuAllFiles (sPath)

MsgBox "处理完成!!!"

End If

oWord.Quit

Set oWord = Nothing

End Sub

Function GetPath() As String

'声明一个FileDialog对象变量

Dim oFD As FileDialog

' '创建一个选择文件对话框

' Set oFD = Application.FileDialog(msoFileDialogFilePicker)

'创建一个选择文件夹对话框

Set oFD = Application.FileDialog(msoFileDialogFolderPicker)

'声明一个变量用来存储选择的文件名

Dim vrtSelectedItem As Variant

With oFD

'允许选择多个文件

.AllowMultiSelect = True

'使用Show方法显示对话框，如果单击了确定按钮则返回-1。

If .Show = -1 Then

'遍历所有选择的文件

For Each vrtSelectedItem In .SelectedItems

'获取所有选择的文件的完整路径,用于各种操作

GetPath = vrtSelectedItem

Else

End If

End With

'释放对象变量

Set oFD = Nothing

End Function

Function GetFileName(ByVal sName As String)

'获取纯文件名的自定义函数

'QQ1722187970

Dim sTemp As String

sTemp = sName

'判断后缀名分隔符.的位置

iPos = Len(sTemp) - VBA.InStr(1, VBA.StrReverse(sTemp), ".")

If iPos <> 0 Then

sTemp = Mid(sTemp, 1, iPos)

End If

'判断路径分隔符\的位置

iPos = VBA.InStr(1, sTemp, "\")

If iPos <> 0 Then

'反转后好取字符

iPos = VBA.InStr(1, VBA.StrReverse(sTemp), "\")

sTemp = Mid(VBA.StrReverse(sTemp), 1, iPos - 1)

sTemp = VBA.StrReverse(sTemp)

End If

GetFileName = sTemp

End Function

Sub EnuAllFiles(ByVal sPath As String, Optional bEnuSub As Boolean = False)

'定义文件系统对象

Dim oFso As Object

Set oFso = CreateObject("Scripting.FileSystemObject")

'定义文件夹对象

Dim oFolder As Object

Set oFolder = oFso.GetFolder(sPath)

'定义文件对象

Dim oFile As Object

'如果指定的文件夹含有文件

If oFolder.Files.Count Then

For Each oFile In oFolder.Files

With oFile

'输出文件所在的盘符

Dim sDrive As String

sDrive = .Drive

'输出文件的类型

Dim sType As String

sType = .Type

'输出含后缀名的文件名称

Dim sName As String

sName = .Name

'输出含文件名的完整路径

Dim sFilePath As String

sFilePath = .Path

'如果文件是Word文件且不是隐藏文件

If sType Like "*ord*2003*" And Not (sName Like "*~$*") Then

Const wdFormatDocumentDefault = 16

Const wdFormatXMLDocument = 12

Const wdWord2013 = 15

Set oDoc = oWord.documents.Open(sFilePath)

With oDoc

Dim sFPath As String

sFPath = .Path

sName = .Name

sName = GetFileName(sName)

sName = sFPath & "\" & sName & ".docx"

.SaveAs2 Filename:=sName, FileFormat:=wdFormatDocumentDefault, CompatibilityMode:=wdWord2013

.Close

End With

End If

End With

Else

End If

'如果要遍历子文件夹

If bEnuSub = True Then

'定义子文件夹集合对象

Dim oSubFolders As Object

Set oSubFolders = oFolder.SubFolders

If oSubFolders.Count > 0 Then

For Each oTempFolder In oSubFolders

sTempPath = oTempFolder.Path

Call EnuAllFiles(sTempPath, True)

Set oSubFolders = Nothing

End If

Set oFile = Nothing

Set oFolder = Nothing

Set oFso = Nothing

End Sub

如何在vba中使用Word Application对象的邮件合并事件？

2018年9月10日作者：exceloffice

暂无评论

在word中内置了许多与邮件合并相关的事件，这些邮件合并的事件都是由Application对象触发的，具体如下图所示：

灵活地使用这些事件，可以极大地增强邮件合并的功能。

比如希望在邮件合并完成以后，将邮件合并后文档中表格的空白行删除，可以使用Application.MailMe[……]

阅读全文

如何用vba遍历含有合并单元格的word表格？

2018年8月28日作者：exceloffice

暂无评论

在用vba处理word的表格时，经常会遇到word表格中的合并单元格。

它不同于excel的合并单元格，word vba表格中没有属性可以判断单元格是否是合并单元格。

当遇到word表格中有合并单元格时，如果用逐个单元格遍历的方式，往往会弹出错误的提示。

如下图所示

[……]

阅读全文

如何用vba选中word表格中行、列、单元格？

2018年8月28日作者：exceloffice

暂无评论

在vba中处理excel单元格区域时，是不建议先选中单元格再操作的，这样会降低代码的运行速度。

但是用vba处理word文档时，先选择指定的内容，再执行相应的操作反而可以提高代码的运行速度。

处理word表格时，遇到合并单元格，用遍历的方式往往会弹出错误的提示，这时候用选中单元格、行、列[……]

阅读全文

如何用vba按照格式查找替换word文本？

2018年8月27日作者：exceloffice

暂无评论

在如何用vba实现word的查找替换？一文中我们介绍了用vba实现word的文本的查找替换。

在word中除了文本的查找替换以外，还会遇到格式的查找替换。

我们需要通过格式查找具体的字符，并对查找到的字符执行相应的操作，如批量替换为其它格式，或者批量替换为其它字符等。

比如查找某种[……]

阅读全文

如何用vba批量删除word表格中的空白行、空白列？

2018年8月27日作者：exceloffice

暂无评论

在word中处理表格与在excel中处理表格是截然不同的。

如果要删除word表格中的行，可以使用Table对象的Rows属性返回具体的行，然后用Delete方法。

同理，如果要删除word表格中的列，可以使用Table对象的Columns属性返回具体的列，然后用Delete方法。[……]

阅读全文

如何用vba不保存关闭所有打开的word文档？

2018年8月16日作者：exceloffice

暂无评论

在用vba遍历文件夹中的word文档时，可以选择每个文档打开后关闭，也可以选择全部文档打开后再批量关闭。

要关闭word文档，需要用到Document.Close方法。

它的语法如下：

expression . Close( SaveChanges , OriginalFormat , RouteDocument )

1	expression . Close( SaveChanges , OriginalFormat , RouteDocument )

其中SaveChanges参数是[……]

阅读全文

如何用vba操作word文档的邮件合并？

2018年8月15日作者：exceloffice

暂无评论

word vba中MailMerge对象代表邮件合并。

一个word文档中有且仅有一个MailMerge对象。

所有与邮件合并相关的操作都可以通过操作MailMerge对象来实现。

以下是一个显示邮件合并连接字符串的代码：
[crayon-5bc913bf8b0af7909111[……]

阅读全文

如何用vba把word文档的每页单独保存为一个word文档？

2018年8月7日作者：exceloffice

暂无评论

要将word文档的每页单独保存为一个word文档，首先需要能够逐页遍历word文档。

逐页遍历word文档可以使用word的定位功能。

代码如下：

Sub QQ1722187970()
    Const wdNumberOfPagesInDocument = 4
    Const wdGoToPage = 1
    Const wdGoToAbsolute = 1
    Dim oDoc As Document
    Dim oRng As Range
    Dim oDocTemp As Document
    Set oDoc = Word.ActiveDocument
    Dim sPath As String
    sPath = Word.ActiveDocument.Path
    Dim iPageNo As Long
    '获取总页数
    With oDoc
    iPageNo = .Range.Information(wdNumberOfPagesInDocument)
        For I = 1 To iPageNo
            '定位到页开始
            Set oRng = .GoTo(wdGoToPage, Which:=wdGoToAbsolute, Count:=I)
            oRng.Select
            '定位整个页面区域
            oRng.SetRange oRng.Start, oRng.Bookmarks("\page").End
            oRng.Copy
            Set oDocTemp = Word.Documents.Add
            With oDocTemp.Application.Selection
                .Paste
            End With
            oDocTemp.SaveAs2 sPath & "\" & I & ".docx"
            oDocTemp.Close
        Next I
    End With
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

Sub QQ1722187970()

Const wdNumberOfPagesInDocument = 4

Const wdGoToPage = 1

Const wdGoToAbsolute = 1

Dim oDoc As Document

Dim oRng As Range

Dim oDocTemp As Document

Set oDoc = Word.ActiveDocument

Dim sPath As String

sPath = Word.ActiveDocument.Path

Dim iPageNo As Long

'获取总页数

With oDoc

iPageNo = .Range.Information(wdNumberOfPagesInDocument)

For I = 1 To iPageNo

'定位到页开始

Set oRng = .GoTo(wdGoToPage, Which:=wdGoToAbsolute, Count:=I)

oRng.Select

'定位整个页面区域

oRng.SetRange oRng.Start, oRng.Bookmarks("\page").End

oRng.Copy

Set oDocTemp = Word.Documents.Add

With oDocTemp.Application.Selection

.Paste

End With

oDocTemp.SaveAs2 sPath & "\" & I & ".docx"

oDocTemp.Close

Next I

End With

End Sub

近期文章

关键字

功能