6个简单而有用的VBA自定义函数_怡然

http://blog.sina.com.cn/u/1070342235

首页博文目录关于我

个人资料

微博

加好友发纸条

写留言加关注

博客等级：
博客积分：

博客访问：
关注人气：
获赠金笔：0支
赠出金笔：0支
荣誉徽章：

正文字体大小：大中小

6个简单而有用的VBA自定义函数

(2018-05-24 16:41:00)

标签：

excel

vba

代码

分类： VBA专区

VBA内部有许多有用的内建函数，但对于好些常规任务(或常见的问题)仍然需要编写自定义函数，这些问题是比较通用的。如检查一个文件是否存在等。

这里包括了6个非常有用自定义VBA函数，你可以简单的复制这些代码到你的模块中，以备方便调用。

这些函数包括：
FileExists：检查一个文件是否存在
– Returns TRUE if a particular file exists.
FileNameOnly：从路径中提取文件名
– Extracts the filename part of a path/filename string.
PathExists：检查路径是否存在
– Returns TRUE if a particular path exists.
RangeNameExists：区域名称是否已存在
– Returns TRUE if a particular range name exists.
SheetExists：检查工作表是否存在
– Returns TRUE if a particular sheet exists.
WorkBookIsOpen：检查工作簿是否打开
– Returns TRUE if a particular workbook is open.
具体代码如下：
The FileExists Function

1.Private Function FileExists(fname) As Boolean

2.

'  
Returns TRUE if the file exists

3. Dim x As String

4.

x
= Dir(fname)

5. If x <> "" Then FileExists = True _

6. Else FileExists = False

7.End Function

The FileNameOnly Function

01.Private Function FileNameOnly(pname) As String

02.

'  
Returns the filename from a path/filename
string

03. Dim i As Integer

,
length

As Integer

,
temp

As String

04.

length
= Len(pname)

05.

temp
=

""

06. For i = length To 1 Step -1

07. If Mid(pname, i, 1) = Application.PathSeparator Then

08.

FileNameOnly
= temp

09. Exit Function

10. End If

11.

temp
= Mid(pname, i, 1) & temp

12. Next i

13.

FileNameOnly
= pname

14.End Function

The PathExists Function

1.Private Function PathExists(pname) As Boolean

2.

'  
Returns TRUE if the path exists

3. Dim x As String

4. On Error Resume Next

5.

x
= GetAttr(pname)

And 0

6. If Err = 0 Then PathExists = True _

7. Else PathExists = False

8.End Function

The RangeNameExists Function

01.Private Function RangeNameExists(nname) As Boolean

02.

'  
Returns TRUE if the range name exists

03. Dim n As Name

04.

RangeNameExists
=

False

05. For Each n In ActiveWorkbook.Names

06. If UCase(n.Name) = UCase(nname) Then

07.

RangeNameExists
=

True

08. Exit Function

09. End If

10. Next n

11.End Function

The SheetExists Function

1.Private Function SheetExists(sname) As Boolean

2.

'  
Returns TRUE if sheet exists in the active
workbook

3. Dim x As Object

4. On Error Resume Next

5. Set x = ActiveWorkbook.Sheets(sname)

6. If Err = 0 Then SheetExists = True _

7. Else SheetExists = False

8.End Function

The WorkbookIsOpen Function

1.Private Function WorkbookIsOpen(wbname) As Boolean

2.

'  
Returns TRUE if the workbook is open

3. Dim x As Workbook

4. On Error Resume Next

5. Set x = Workbooks(wbname)

6. If Err = 0 Then

WorkbookIsOpen
=

True _

7. Else WorkbookIsOpen = False

8.End Function

阅读┊ 收藏 ┊ 喜欢 ▼ ┊打印┊举报/Report

前一篇：VBA对Word行、段落和光标位置的移动、选择和操作

后一篇：VBA以GIF文件格式导出Excel图表

新浪BLOG意见反馈留言板　欢迎批评指正