Office365|VBA教程|Excel教程|Word教程|WPS-ExcelOffice

如何用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.MailMergeAfterMerg事件，步骤如下：

1.在ThisDocument类模块的模块级声明中定[……]

阅读全文

如何在ppt中用vba实现图形的布尔运算？

2018年9月9日作者：exceloffice

暂无评论

布尔运算是数字符号化的逻辑推演法，包括联合、相交、相减。

在图形处理操作中引用了这种逻辑运算方法以使简单的基本图形组合产生新的形体，并由二维布尔运算发展到三维图形的布尔运算。

在PPT幻灯片中，当选中2个以上（含2个）图形时，在“绘图工具”选项下的“格式”下的“插入形状”组中可以使用“合并形状”命令实现图形的布尔运算，如下图所示：

接下来，解释各个“合并形状”命令的具体效[……]

阅读全文

如何用vba在excel工作表中插入同心不同半径的圆或者半圆？

2018年9月7日作者：exceloffice

暂无评论

如下图所示：

如果要在工作表中插入两个同心半圆或者圆，根据如何用vba在excel工作表中插入圆？和如何用vba在excel工作表中插入半圆？中介绍的。

当用vba在工作表中插入圆或者半圆时，AddShape需要提供4个参数，分别为图形的左上角的X、Y坐标值，以及图形的宽、高值。

当宽、高值相等时，为圆形。

如果要插入同心圆，需要计算圆心的坐标，然后根据圆心的坐[……]

阅读全文

如何用vba将照片按照修改日期或者创建日期重命名？

2018年9月7日作者：exceloffice

暂无评论

照片也属于文件。

在VBA中通过访问文件对象File的DateLastModified、DateCreated、DateLastAccessed等属性可以获取文件的最后一次修改日期、文件的创建日期、以及文件的最后一次打开日期。

然后用Name语句可以将文件重命名，如果需要对文件夹中的所有照片都重命名，还需要添加遍历文件夹代码。

基于以上的知识，可以使用如下的代码将文件夹内的所有J[……]

阅读全文

如何用vba在excel工作表中插入半圆？

2018年9月6日作者：exceloffice

暂无评论

在如何在excel工作表中插入半圆？一文中我们介绍了如何通过操作在excel中插入半圆。

但是细心的你可能已经发现了，通过调整“不完整圆”虽然可以调整到形式“半圆”的图形，但是不能获得一个精准的“半圆”。

通过vba，我们可以实现插入一个精准的半圆。

在vba中可以用Shapes集合对象的AddShape方法插入图形。

AddShape方法的语法如下：
[crayon-[……]

阅读全文

如何在excel工作表中插入半圆？

2018年9月6日作者：exceloffice

暂无评论

在如何用vba在excel工作表中插入圆？一文中我们介绍了如何通过操作的方法在excel工作表中插入一个圆形。

今天我们介绍如何在excel工作表中插入一个半圆。

同插入圆形一样，在excel的“插入”选项卡下的“插图”工作组中的“形状”中找不到“半圆”形状。

但是我们可以通过插入“不完整圆”这个形状，然后调节“不完整圆”形状，使其成为“半圆”形状。

如下图所示：[……]

阅读全文

如何用vba在excel工作表中插入圆？

2018年9月6日作者：exceloffice

暂无评论

在如何在excel中插入圆形？一文中，我们介绍了如何通过操作插入一个圆形。

在vba中可以用Shapes集合对象的AddShape方法插入图形。

AddShape方法的语法如下：

expression. AddShape( _Type_ , _Left_ , _Top_ , _Width_ , _Height_ )

1	expression. AddShape( _Type_ , _Left_ , _Top_ , _Width_ , _Height_ )

其中Type参数表示要插入的图形的类型，具体的参数值可以见图形类型。

比如以下的代码将在工作表中插入一个圆形：
[crayon[……]

阅读全文

如何在excel工作表中插入圆形？

2018年9月6日作者：exceloffice

暂无评论

在excel的“插入”选项卡下的“插图”工作组中可以选择“形状”插入，如下图所示：

在所有的可插入形状中，我们会发现找不到可以插入“圆”形状。

这时候可以通过插入“椭圆”形状，然后设置“椭圆”形状的长、宽为相同的值，即可实现插入“圆”形状，如下图所示：

如何用vba设置图表系列数据点的数据标记的类型和大小？

2018年9月6日作者：exceloffice

暂无评论

如下图所示

在excel图表中，可以设置数据标记为自动、无、以及自定义的图形，还可以设置数据标记的大小。

在vba中分别可以设置系列Series、数据点Point、图例LegendKey对象的数据标记。

其中MarkerStyle属性为数据标记的类型，MarkerSize属性为数据标记的大小，可以是2到72。还可以通过MarkerBackgroundColor和Marke[……]

阅读全文

近期文章

关键字

功能