VBA 部分实用函数

今天的学习课程一共是两个，一个是把昨天提到的常用的函数写一遍，另一个是学习一些新函数

 

一、昨天提到的相关函数

https://blog.csdn.net/Di77HaoWenMing/article/details/107886745

1.判断文件是否存在的函数 FileExists

文件是否存在主要是用Dir(path)进行判断，不为空留存在啦

Private Function FileExistx(path As String) As Boolean
    FileExistx = False
    If Dir(path) <> "" Then
        FileExistx = True
    End If
End Function

2.根据路径只获取文件名称 FileNameOnly

主要思路是根据文件的路径地址，截取最右边的小数点 . 到最右边的斜杠 \ 之间的内容，即为文件名。需要用到split函数

如果截取文件名+后缀的话，以下语句即可

Private Function FileNameOnly(filePath As String)
    If Dir(filePath) <> "" Then
        FileNameOnly = Dir(filePath)
    End If
End Function

如果不需要后缀的话，可以用以下方式

Private Function FileNameOnly(filPath As String)
    If Dir(filPath) <> "" Then
        FileNameOnly = Split(Dir(filPath), ".")(0)
    End If
End Function

但是这个会有个问题，就是文件名本身带有小数点的话，截取文件名会出错，比如文件地址是"E:\VBA\常用函数2.0.00002.000版本.xlsm"，提取文件名时只会获取到”\常用函数2“为止，所以还需要改一下。

Private Function FileNameOnly(filePath As String) As String
    Dim temp As Integer
    If Dir(filePath) <> "" Then
        '用InStrRev判断最右边的点 . 出现的位置
        temp = InStrRev(Dir(filePath), ".")
        FileNameOnly = Left(Dir(filePath), temp - 1)
    End If
End Function

3.判断路径是否存在 PathExists

主要思路也是用Dir(path,vbDirectory)判断

Private Function PathExists(path) As Boolean
    PathExists = False
    If Dir(path, vbDirectory) <> "" Then
        PathExists = True
    End If
End Function

4.判断活动工作簿是否存在单元格区域名称

RangeNameExists

主要思路：一是用工作簿名称和Range区域名称进行比对；另一种是直接将Range进行赋值，看是否回出现错误。

Private Function RangeNameExists(rname) As Boolean
    Dim wb As WorkBook
    RangeNameExists = False
    For Each wb In Workbooks
        If wb.Name = rname Then
            RangeNameExists = True
            Exit Function
        End If
    Next
End Function

5.判断工作表是否存在SheetExists。

思路和上面一样，根据sheet.Name进行判断

 

6.判断工作簿是否打开WorkbookIsOpen

思路是将工作簿名称进行赋值，没报错误就说明打开了。

Private Function WorkbookIsOpen(wbname As String) As Boolean
    WorkbookIsOpen = False
    On Error Resume Next
    Dim x As WorkBook
    Set x = Workbooks(wbname)
    If Err.Number = 0 Then WorkbookIsOpen = True
End Function

7.判断一个成员在集合中是否存在IsInCollection。

感觉这个很通用，什么都可以放进去测试一下

Private Function IsIncollection(obj As Object, str As String) As Boolean
    IsIncollection = False
    On Error Resume Next
    Dim x As Object
    Set x = obj(str)
    If Err.Number = 0 Then IsIncollection = True
End Function

8.从关闭的工作表获取值

主要通过调用XML宏，用ExecuteExcel4Macro()实现。

我们先在A表的单元格内输入=B表的某个单元格的值，再关掉B表。就会发现原来写的=B表的值链接会发生变化：

='E:\VBA呀呀呀\[单元格操作.xlsm]Sheet1'!$A$2

所以咱们要引用关闭的表格中的值，传入到ExecuteExcel4Macro中的参数也大概长这样，主要是引号、感叹号、中括号需要加进去

Private Function GetValue(path As String, file As String, sh As String, ref As String) As String
    If (Dir(path, vbDirectory)) = "" Then
        GetValue = "找不到路径"
        Exit Function
    End If
    If (Dir(path & "\" & file)) = "" Then
        GetValue = "找不到文件"
        Exit Function
    End If

    Dim x As String
    x = "'" & path & "\" & "[" & file & "]" & sh & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
    GetValue = ExecuteExcel4Macro(x)
End Function

 

咱们用以下方式调用一下

Sub runF()
    Dim path As String, file As String, sh As String, rng As String
    path = "E:\VBA呀呀呀"
    file = "单元格操作.xlsm"
    sh = "Sheet1"
    rng = "A1"
    MsgBox GetValue(path, file, sh, rng)
End Sub

当然为了防止报错，也可以先把x输出一下，看看要传入到ExecuteExcel4Macro()中的参数是不是和之前提到的

='E:\VBA呀呀呀\[单元格操作.xlsm]Sheet1'!$A$2

经过实际测试，调用成功！输出结果如下：

 

二、今天学习的相关函数

1.返回单元格格式信息。

判断是否加粗（条件格式设置的加粗无法判断）

Function ISBOLD(cell) As Boolean
    ISBOLD = cell.Font.Bold = True
End Function

判断是否是斜体

Function ISITLIC(cell) As Boolean
    ISITLIC = cell.Font.Italic = True
End Function

需要注意：如果一个单元格内有多种格式，会出错哟

输出单元格底色信息，我们可以看到红色的底色是3

Function FILLCOLOR(cell) As Integer
    FILLCOLOR = cell.Interior.ColorIndex
End Function

为毛红色是3呢？咱们写个循环，看看各个colorindex对应什么颜色，颜色最多到56哟，再大会报错

2.输出语音。看起来还比较炫酷，其实也就系统函数一句话的事儿~

Function SAYIT(txt) Application.Speech.Speak (txt) End Function

经过测试，中英文都能够输出语音哟

 

今天就到这啦，明天继续~