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

如何在excel中显示“开发工具”选项卡?

2018年11月7日作者：exceloffice

暂无评论

如下图所示

如果要在excel中显示“开发工具”选项卡，可以按照以下步骤：

单击“文件”选项卡，单击“选项”按钮
在弹出的“excel选项”对话框中单击“自定义功能区”，在“主选项卡”下勾选“开发工具”，然后单击“确定”按钮即可在excel中显示“开发工具”选项卡。

如何用vba抓取存在本地电脑上的Html网页文件中的内容？

2018年11月5日作者：exceloffice

暂无评论

本地电脑上的Html网页文件可以直接用记事本打开，打开后显示的是网页对应的源代码。

有了这个知识，就可以用通用的处理文本文件的代码处理本地的Html网页文件，将源代码用vba函数split分割或者用Html DOM方法读取。

以下是一个遍历任意指定文件夹下的所有Html网页文件并提取其中的手机号码后写入空白的文本文档中的代码：
[crayon-5bea3374417730369274[……]

阅读全文

如何用vba判断一个文件是否存在？

2018年11月5日作者：exceloffice

暂无评论

在编写vba的解决方案时，经常需要与文件打交道。

FileSystemObject对象提供了一系列关于操作文件的对象、属性和方法。

其中FileExists方法可以用于判断文件是否存在。

以下是一个用FileExists方法判断指定的文本文档是否存在的代码：

Sub qq1722187970()
    Excel.Application.ScreenUpdating = False
    Excel.Application.Calculation = xlCalculationManual
    Excel.Application.DisplayAlerts = False
    Dim sFliePath As String
    sFliePath = Excel.ThisWorkbook.Path & "/test.txt"
    Dim oFSO As Object
    Dim oTextStream As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    With oFSO
        '如果存在指定的文件
        If .FileExists(sFliePath) Then
        '操作代码
        Else
        '如果存在指定的文件
        '操作代码
        End If
    End With
    Excel.Application.ScreenUpdating = True
    Excel.Application.Calculation = xlCalculationAutomatic
    Excel.Application.DisplayAlerts = True
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

Sub qq1722187970()

Excel.Application.ScreenUpdating = False

Excel.Application.Calculation = xlCalculationManual

Excel.Application.DisplayAlerts = False

Dim sFliePath As String

sFliePath = Excel.ThisWorkbook.Path & "/test.txt"

Dim oFSO As Object

Dim oTextStream As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")

With oFSO

'如果存在指定的文件

If .FileExists(sFliePath) Then

'操作代码

Else

'如果存在指定的文件

'操作代码

End If

End With

Excel.Application.ScreenUpdating = True

Excel.Application.Calculation = xlCalculationAutomatic

Excel.Application.DisplayAlerts = True

End Sub

如何在vba中用OpenTextFile方法读写文本文档?

2018年11月5日作者：exceloffice

暂无评论

在编写vba的解决方案时，经常会碰到需要读写文本文档的情况。

FileSystemObject对象提供了一系列读写文本文档的对象、属性和方法。

其中可以使用OpenTextFile方法打开一个文本文档，并返回一个TextStream对象。

它的语法如下：

object.OpenTextFile(filename[, iomode[, create[, format]]])

1	object.OpenTextFile(filename[, iomode[, create[, format]]])

其中参数filename为要打开的文本文档的完整路径，[……]

阅读全文

如何用vba实现百度搜索？

2018年11月2日作者：exceloffice

暂无评论

百度，不用介绍，大家都熟悉。

百度的搜索功能，也不用介绍，大家也都熟悉。

当我们需要对一批数据进行百度搜索时，可能我们会选择逐个输入到百度搜索框中进行搜索，这个是非常耗时而且低效的。

其实可以通过网抓的代码实现批量百度搜索。

以下是一个通用的用vba实现百度搜索，返回百度搜索第一页的网页源代码：

Sub QQ1722187970()
    Dim oWK As Worksheet
    Set oWK = Sheet1
    iRow = oWK.Range("a65536").End(xlUp).Row + 1
    Dim oHtml As Object
    Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")
    Dim sUrl As String
    Dim sCharset As String
    sCharset = "utf-8"
    For i = 2 To iRow
        'A列为要查找的关键词
        sText = oWK.Cells(i, "a")
        sUrl = "http://www.baidu.com/s?wd=" & sText
        With oHtml
            .Open "GET", sUrl, False
            .send
            '获取返回的字节数组
            bResult = .ResponseBody
            '将源代码显示出来,同时获取源代码的文本
            sResult = Byte2Txt(bResult, sCharset)
        End With
    Next i
End Sub
Function HtmlBasic(ByVal sVerb As String, ByVal sUrl As String, Optional ByVal sCharset As String = "utf-8", Optional ByVal sPostData As String = "")
    'sVerb为发送的Html请求的方法,sUrl为具体的网址,sCharset为网址对应的字符集编码,sPostData为Post方法对应的发送body
    Dim oHtml As Object
    'https://msdn.microsoft.com/en-us/library/windows/desktop/aa384106(v=vs.85).aspx
    Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")
    With oHtml
        Select Case sVerb
            Case "GET"
                .Open "GET", sUrl, False
            Case "POST"
                .Open "POST", sUrl, False
                .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        End Select
        .send (sPostData)
        '获取返回的字节数组
        bResult = .ResponseBody
        '按照指定的字符编码显示
        sResult = Byte2String(bResult, sCharset)
        Debug.Print sResult
        HtmlBasic = sResult
    End With
    Set oHtml = Nothing
End Function
'将抓取网页的返回字节转变为文本
Function Byte2String(bContent, ByVal sCharset As String)
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adModeRead = 1
    Const adModeWrite = 2
    Const adModeReadWrite = 3
    Dim oStream As Object
    '创建流对象
    Set oStream = CreateObject("ADODB.Stream")
    With oStream
        '打开流
        .Open
        '设置为字节模式
        .Type = adTypeBinary
        '写入字节
        .write bContent
        '将位置定位在第一个字节
        .Position = 0
        '设置为文本模式
        .Type = adTypeText
        '设置编码的字符集
        .Charset = sCharset
        '读取编码后的文本
         Byte2String = .ReadText
        '关闭流对象
        .Close
    End With
End Function
'将抓取的网页的源代码显示在文本文档中
Function Byte2Txt(bContent, ByVal sCharset As String)
    '添加容错语句，防止文本文件不存在时，Kill语句出错
    On Error Resume Next
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adModeRead = 1
    Const adModeWrite = 2
    Const adModeReadWrite = 3
    Dim oStream As Object
    '创建流对象
    Set oStream = CreateObject("ADODB.Stream")
    With oStream
        '打开流
        .Open
        '设置为字节模式
        .Type = adTypeBinary
        '写入字节
        .write bContent
        '将位置定位在第一个字节
        .Position = 0
        '设置为文本模式
        .Type = adTypeText
        '设置编码的字符集
        .Charset = sCharset
        '读取编码后的文本
        Byte2Txt = .ReadText
        sPath = Excel.ThisWorkbook.Path
        sFilePath = sPath & "\view-source.txt"
        Kill sFilePath
        '将源代码保存到文本文件中
        .SaveToFile sFilePath
        '打开文本文件
        Shell ("notepad " & sFilePath), vbMaximizedFocus
        '关闭流对象
        .Close
    End With
End Function
'提取网页表格的代码
Sub HtmlTable(ByVal sHtml As String)
    '网页html文档对象
    Dim oHtmlDom As Object
    '网页表格对象
    Dim oTable As Object
    '网页表格行对象
    Dim oRows As Object
    '网页表格单元格对象
    Dim oCells As Object
    '抓取的数据存放的excel表格对象
    Dim oWK As Worksheet
    Set oWK = Sheet1
    iRow = oWK.Range("a65536").End(xlUp).Row + 1
    Set oHtmlDom = CreateObject("htmlfile")
    With oHtmlDom
        .body.innerHTML = sHtml
        Set oTable = .getElementsByTagName("table")(0)
        'Set oTable = getElementById("id")
        With oTable
            Set oRows = .Rows
            For i = 1 To oRows.Length - 1
                Set oCells = oRows(i).Cells
                For j = 0 To oCells.Length - 1
                    oWK.Cells(iRow, j + 1) = oCells(j).innertext
                Next j
                iRow = iRow + 1
            Next i
        End With
    End With
    Set oHtmlDom = Nothing
    Set oTable = Nothing
    Set oRows = Nothing
    Set oCells = 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

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

Sub QQ1722187970()

Dim oWK As Worksheet

Set oWK = Sheet1

iRow = oWK.Range("a65536").End(xlUp).Row + 1

Dim oHtml As Object

Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")

Dim sUrl As String

Dim sCharset As String

sCharset = "utf-8"

For i = 2 To iRow

'A列为要查找的关键词

sText = oWK.Cells(i, "a")

sUrl = "http://www.baidu.com/s?wd=" & sText

With oHtml

.Open "GET", sUrl, False

.send

'获取返回的字节数组

bResult = .ResponseBody

'将源代码显示出来,同时获取源代码的文本

sResult = Byte2Txt(bResult, sCharset)

End With

Next i

End Sub

Function HtmlBasic(ByVal sVerb As String, ByVal sUrl As String, Optional ByVal sCharset As String = "utf-8", Optional ByVal sPostData As String = "")

'sVerb为发送的Html请求的方法,sUrl为具体的网址,sCharset为网址对应的字符集编码,sPostData为Post方法对应的发送body

Dim oHtml As Object

'https://msdn.microsoft.com/en-us/library/windows/desktop/aa384106(v=vs.85).aspx

Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")

With oHtml

Select Case sVerb

Case "GET"

.Open "GET", sUrl, False

Case "POST"

.Open "POST", sUrl, False

.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"

End Select

.send (sPostData)

'获取返回的字节数组

bResult = .ResponseBody

'按照指定的字符编码显示

sResult = Byte2String(bResult, sCharset)

Debug.Print sResult

HtmlBasic = sResult

End With

Set oHtml = Nothing

End Function

'将抓取网页的返回字节转变为文本

Function Byte2String(bContent, ByVal sCharset As String)

Const adTypeBinary = 1

Const adTypeText = 2

Const adModeRead = 1

Const adModeWrite = 2

Const adModeReadWrite = 3

Dim oStream As Object

'创建流对象

Set oStream = CreateObject("ADODB.Stream")

With oStream

'打开流

.Open

'设置为字节模式

.Type = adTypeBinary

'写入字节

.write bContent

'将位置定位在第一个字节

.Position = 0

'设置为文本模式

.Type = adTypeText

'设置编码的字符集

.Charset = sCharset

'读取编码后的文本

Byte2String = .ReadText

'关闭流对象

.Close

End With

End Function

'将抓取的网页的源代码显示在文本文档中

Function Byte2Txt(bContent, ByVal sCharset As String)

'添加容错语句，防止文本文件不存在时，Kill语句出错

On Error Resume Next

Const adTypeBinary = 1

Const adTypeText = 2

Const adModeRead = 1

Const adModeWrite = 2

Const adModeReadWrite = 3

Dim oStream As Object

'创建流对象

Set oStream = CreateObject("ADODB.Stream")

With oStream

'打开流

.Open

'设置为字节模式

.Type = adTypeBinary

'写入字节

.write bContent

'将位置定位在第一个字节

.Position = 0

'设置为文本模式

.Type = adTypeText

'设置编码的字符集

.Charset = sCharset

'读取编码后的文本

Byte2Txt = .ReadText

sPath = Excel.ThisWorkbook.Path

sFilePath = sPath & "\view-source.txt"

Kill sFilePath

'将源代码保存到文本文件中

.SaveToFile sFilePath

'打开文本文件

Shell ("notepad " & sFilePath), vbMaximizedFocus

'关闭流对象

.Close

End With

End Function

'提取网页表格的代码

Sub HtmlTable(ByVal sHtml As String)

'网页html文档对象

Dim oHtmlDom As Object

'网页表格对象

Dim oTable As Object

'网页表格行对象

Dim oRows As Object

'网页表格单元格对象

Dim oCells As Object

'抓取的数据存放的excel表格对象

Dim oWK As Worksheet

Set oWK = Sheet1

iRow = oWK.Range("a65536").End(xlUp).Row + 1

Set oHtmlDom = CreateObject("htmlfile")

With oHtmlDom

.body.innerHTML = sHtml

Set oTable = .getElementsByTagName("table")(0)

'Set oTable = getElementById("id")

With oTable

Set oRows = .Rows

For i = 1 To oRows.Length - 1

Set oCells = oRows(i).Cells

For j = 0 To oCells.Length - 1

oWK.Cells(iRow, j + 1) = oCells(j).innertext

Next j

iRow = iRow + 1

Next i

End With

Set oHtmlDom = Nothing

Set oTable = Nothing

Set oRows = Nothing

Set oCells = Nothing

End Sub

在数据量很大时，如何用vba代替countif函数进行计数统计？

2018年11月2日作者：exceloffice

暂无评论

countif函数可以统计单元额区域中指定数据的出现次数，是一个常用的excel函数。

在数据量较少时，这个函数的统计可以很轻松的完成。

但是当遇到十万行级别的数据时，再利用countif函数进行技术统计会导致excel陷入死机或卡机状态，函数的计算非常缓慢。

为了提高在一列单元格区域（数据量非常大）中统计指定数据出现的次数，可以使用字典对象进行统计，以下是一个通用的计数统计示例[……]

阅读全文

如何用vba查找替换word文档中的英文引号为空，而不包含中文引号？

2018年11月2日作者：exceloffice

暂无评论

当word 文档中即有英文引号也有中文引号，当用查找替换查找英文引号替换为空时，会把中文引号也一起替换。

这时候我们可以借助word查找替换中可以直接按照unicode编码查找字符的功能，将英文引号的unicode编码找出来，然后再在查找框中输入形如”^uXXXX”这样的查找内容，只查找英文的引号。

要找到某个字符的unicode编码，一种方法是在word中选中该字符，然后按下Alt+[……]

阅读全文

如何用vba给word文档的右键快捷菜单添加命令？

2018年10月23日作者：exceloffice

暂无评论

如下图所示：

当在word文档中单击鼠标右键时，为弹出的快捷菜单中添加一个自定义的命令“给加粗的字符添加括号”，可以使用以下的代码：

Sub CreateMenu()
      '命令栏
    Dim oCB As CommandBar
    '通用的命令栏控件
    Dim oCBC As CommandBarControl
    '命令按钮控件
    Dim oCBB As CommandBarButton
    '组合框控件
    Dim oCBCom As CommandBarComboBox
    '组合框控件
    Dim oCBCom1 As CommandBarComboBox
    '弹出式菜单
    Dim oCBPop As CommandBarPopup
    Set oCB = Word.Application.CommandBars("Text")
    With oCB
        .Reset
        Set oCBB = .Controls.Add(Before:=1)
        With oCBB
            .Caption = "给加粗的字符添加括号"
            .FaceId = 19
            .OnAction = "xyf"
        End With
    End With
End Sub
Sub xyf()
    MsgBox "测试成功"
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

Sub CreateMenu()

'命令栏

Dim oCB As CommandBar

'通用的命令栏控件

Dim oCBC As CommandBarControl

'命令按钮控件

Dim oCBB As CommandBarButton

'组合框控件

Dim oCBCom As CommandBarComboBox

'组合框控件

Dim oCBCom1 As CommandBarComboBox

'弹出式菜单

Dim oCBPop As CommandBarPopup

Set oCB = Word.Application.CommandBars("Text")

With oCB

.Reset

Set oCBB = .Controls.Add(Before:=1)

With oCBB

.Caption = "给加粗的字符添加括号"

.FaceId = 19

.OnAction = "xyf"

End With

End Sub

Sub xyf()

MsgBox "测试成功"

End Sub

这里特别要注意的是，给word 文档的右键快捷菜单添加自定义命令对应的命令栏是

Word.Application.CommandBars("Text")

1	Word.Application.CommandBars("Text")

如何用word vba列举word应用程序中所有内置命令菜单栏的名称？

2018年10月23日作者：exceloffice

暂无评论

如下图所示

如果要在word文档中列出word应用程序中所有的内置命令菜单栏的名称，可以使用以下的代码：

Sub QQ1722187970()
    Dim oDoc As Document
    Set oDoc = Word.ActiveDocument
    Dim oCB As CommandBar
    Dim oT As Table
    With oDoc
        For Each oT In .Tables
            oT.Delete
        Next
        Set oT = .Tables.Add(.Range, 1, 2)
        With oT
            .Style = "网格型"
            .Cell(1, 1).Range = "命令栏名称"
            .Cell(1, 2).Range = "命令栏中文名称"
            I = 2
            For Each oCB In Word.Application.CommandBars
                .Rows.Add
                .Cell(I, 1).Range = oCB.Name
                .Cell(I, 2).Range = oCB.NameLocal
                I = I + 1
            Next
        End With
    End With
    Set oT = Nothing
    Set oDoc = 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

Sub QQ1722187970()

Dim oDoc As Document

Set oDoc = Word.ActiveDocument

Dim oCB As CommandBar

Dim oT As Table

With oDoc

For Each oT In .Tables

oT.Delete

With oT

.Style = "网格型"

.Cell(1, 1).Range = "命令栏名称"

.Cell(1, 2).Range = "命令栏中文名称"

I = 2

For Each oCB In Word.Application.CommandBars

.Rows.Add

.Cell(I, 1).Range = oCB.Name

.Cell(I, 2).Range = oCB.NameLocal

I = I + 1

End With

Set oT = Nothing

Set oDoc = Nothing

End Sub

如何用word vba 给word文档插入指定行列的表格？

2018年10月23日作者：exceloffice

暂无评论

要用用word vba 给word文档插入指定行列的表格，需要用到Tables对象的Add方法。

以下示例代码可以在当前的word文档中插入一个3×3的表格，表格的样式套用“网格型”：

Sub QQ1722187970()
    Dim oDoc As Document
    Set oDoc = Word.ActiveDocument
    Dim oT As Table
    With oDoc
        Set oT = .Tables.Add(.Range(0, 0), 3, 3)
        With oT
            .Style = "网格型"
        End With
    End With
    Set oT = Nothing
    Set oDoc = Nothing
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

Sub QQ1722187970()

Dim oDoc As Document

Set oDoc = Word.ActiveDocument

Dim oT As Table

With oDoc

Set oT = .Tables.Add(.Range(0, 0), 3, 3)

With oT

.Style = "网格型"

End With

Set oT = Nothing

Set oDoc = Nothing

End Sub

近期文章

关键字

功能