[分享] 在编程中，一些实用的自定义函数

晓月清风

在编程时，时常需要知道工作表是否存在，文件是否存在等，这时候，以下这些自定义函数就能派上用场了：

Private Function FileExists(fname) As Boolean

'当文件存在时返回true

    Dim x As String

    x = Dir(fname)

    If x <> "" Then FileExists = True _

        Else FileExists = False

End Function



Private Function FileNameOnly(pname) As String

'返回路径pname的文件名

    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



Private Function PathExists(pname) As Boolean

'如果路径pname存在则返回true

    Dim x As String

    On Error Resume Next

    x = GetAttr(pname) And 0

    If Err = 0 Then PathExists = True _

      Else PathExists = False

End Function



Private Function RangeNameExists(nname) As Boolean

'如果一个名称存在则返回true

    Dim n As Name

    RangeNameExists = False

    For Each n In ActiveWorkbook.Names

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

            RangeNameExists = True

            Exit Function

        End If

    Next n

End Function



Private Function SheetExists(sname) As Boolean

'如果活动工作簿中存在表SNAME则返回真

    Dim x As Object

    On Error Resume Next

    Set x = ActiveWorkbook.Sheets(sname)

    If Err = 0 Then SheetExists = True _

        Else SheetExists = False

End Function



Private Function WorkbookIsOpen(wbname) As Boolean

'如果工作簿WBNAME打开着，则返回true

    Dim x As Workbook

    On Error Resume Next

    Set x = Workbooks(wbname)

    If Err = 0 Then WorkbookIsOpen = True _

        Else WorkbookIsOpen = False

End Function

红池坝

[em17]

yanwei82123300

不错, 好文

方漠

整理了一下,不错,收藏备用.

Private Function FileExists(fname) As Boolean '当文件存在时返回true
Dim x As String
x = Dir(fname)
If x <> "" Then
    FileExists = True
    Else
    FileExists = False
End if
End Function

Private Function FileNameOnly(pname) As String  '返回路径pname的文件名
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

Private Function PathExists(pname) As Boolean '如果路径pname存在则返回true
Dim x As String
On Error Resume Next
x = GetAttr(pname) And 0
If Err = 0 Then PathExists = True Else PathExists = False
End Function

Private Function RangeNameExists(nname) As Boolean '如果一个名称存在则返回true
Dim n As Name
RangeNameExists = False
For Each n In ActiveWorkbook.Names
  If UCase(n.Name) = UCase(nname) Then
     RangeNameExists = True
      Exit Function
   End If
Next n
End Function

Private Function SheetExists(sname) As Boolean '如果活动工作簿中存在表SNAME则返回true
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname)
If Err = 0 Then
   SheetExists = True
   Else
   SheetExists = False
End if
End Function

Private Function WorkbookIsOpen(wbname) As Boolean '如果工作簿WBNAME打开着，则返回true
Dim x As Workbook
On Error Resume Next
Set x = Workbooks(wbname)
If Err = 0 Then WorkbookIsOpen = True  Else WorkbookIsOpen = False
End Function