Vba 显示在没有.xlsx的列表框中打开的工作簿列表

我创建了多个用户表单，它们打开不同的工作簿。为了了解激活UserForm时打开的工作簿，我创建了一个ListBox ListBox2，向用户显示打开的工作簿。代码如下：

With Me.ListBox2
    For Each wkb In application.Workbooks
        .AddItem wkb.Name
    Next wkb
End With

但显示的工作簿有其扩展。这意味着ListBox2上列出的每个工作簿中都有.xlsx

如何删除这些扩展

您可以使用Left函数，然后使用InStr函数来查找扩展名之前工作簿名称的长度

Dim wb_name As String
wb_name = ThisWorkbook.Name
MsgBox (Left(wb_name, InStr(1, wb_name, ".xls") - 1))

Sub Test()
    Debug.Print GetBaseName("mdl_FILE_Functions.bas")
End Sub

Public Function GetBaseName(FileName As String) As String
    Dim FS As Object
    Set FS = CreateObject("Scripting.FileSystemObject")
    GetBaseName = FS.GetBaseName(FileName)
End Function

在您的场景中：

With Me.ListBox2
    For Each wkb In application.Workbooks
        .AddItem Left(wkb.Name, InStr(1, wkb.Name, ".xls") - 1)
    Next wkb
End With

---

可以通过对字符串使用leftString、numChars函数来删除扩展部分

.AddItem left(wkb.Name,len(wkb.Name)-4)

这是否适用于*.xls？扩展。您可能需要考虑在文件名中检查最后的“.'”，因为这将帮助您消除*.xLS文件，如果它们发生的话，

.AddItem Split(wkb.Name, ".")(0)

或FSO：

.AddItem CreateObject("Scripting.FileSystemObject").GetBaseName(wkb.Name)

---

我可以想到两种方法——使用INSTRREV查找最后一个点。这将显示“.”左侧的所有内容，包括路径（如果存在）

Sub Test()
    Debug.Print FileNameOnly("mdl_FILE_Functions.bas")
End Sub

Public Function FileNameOnly(ByVal FileName As String) As String
    FileNameOnly = Left(FileName, InStrRev(FileName, ".") - 1)
End Function

或Scripting.FileSystemObject返回基名称。这将只返回文件名并删除路径和扩展名

Dim wb_name As String
wb_name = ThisWorkbook.Name
MsgBox (Left(wb_name, InStr(1, wb_name, ".xls") - 1))

Sub Test()
    Debug.Print GetBaseName("mdl_FILE_Functions.bas")
End Sub

Public Function GetBaseName(FileName As String) As String
    Dim FS As Object
    Set FS = CreateObject("Scripting.FileSystemObject")
    GetBaseName = FS.GetBaseName(FileName)
End Function