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

比眉伴天荒 2023-06-17 12:53 6阅读 0赞

[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**

Private Function FileExists(fname) As Boolean
    '   Returns TRUE if the file exists
        Dim x As String
        x = Dir(fname)
        If x <> "" Then FileExists = True _
            Else FileExists = False
    End Function

**The FileNameOnly Function**

Private Function FileNameOnly(pname) As String
    '   Returns the filename from a path/filename string
        Dim i As Integer, length As Integer, temp As String
        length = Len(pname)
        temp = ""
        For i = length To 1 Step -1
            If Mid(pname, i, 1) = Application.PathSeparator Then
                FileNameOnly = temp
                Exit Function
            End If
            temp = Mid(pname, i, 1) & temp
        Next i
        FileNameOnly = pname
    End Function

**The PathExists Function**

Private Function PathExists(pname) As Boolean
    '   Returns TRUE if the path exists
        Dim x As String
        On Error Resume Next
        x = GetAttr(pname) And 0
        If Err = 0 Then PathExists = True _
          Else PathExists = False
    End Function

**The RangeNameExists Function**

**The SheetExists Function**

Private Function SheetExists(sname) As Boolean
    '   Returns TRUE if sheet exists in the active workbook
        Dim x As Object
        On Error Resume Next
        Set x = ActiveWorkbook.Sheets(sname)
        If Err = 0 Then SheetExists = True _
            Else SheetExists = False
    End Function

**The WorkbookIsOpen Function**

Private Function WorkbookIsOpen(wbname) As Boolean
    '   Returns TRUE if the workbook is open
        Dim x As Workbook
        On Error Resume Next
        Set x = Workbooks(wbname)
        If Err = 0 Then WorkbookIsOpen = True _
            Else WorkbookIsOpen = False
    End Function

[VBA]: http://www.cnhup.com/index.php/archives/tag/vba/