是不是WPS中VBA对于filedialog有什么限制，筛选属性没起作用

kutmis

下面这段代码，我就想实现一个比较简单的功能，总体上也都正常，就是弹出另存对话框时，显示的文件过滤选项并没有只显示xlsx文件，而是系统默认的各种文件类型的，不知道是我写错了，还是wps和ms office就是不一样，难道wps不能在另存对话框筛选文件类型么
           Dim fd As FileDialog
            Dim savefile As String
            Set fd = Application.FileDialog(msoFileDialogSaveAs)
            fd.AllowMultiSelect = False
            fd.Filters.Add "Excel Files", "*.xlsx"

            fd.InitialFileName = file_path & desfilename
            If fd.Show = -1 Then
                savefile = fd.SelectedItems(1)
                wb_des.SaveAs Filename:=savefile
                MsgBox "已完成。共合并了" & cnt & "个文件！", vbInformation
            Else
                MsgBox "用户取消了合并文件", vbInformation
                wb_des.Close savechanges:=False
            End If

lss001

With Application.FileDialog(2)
    .AllowMultiSelect = False
    .FilterIndex = 5 '方式1：指定序号
               
   'fType = ThisWorkBook.Path & "\xxx.xlsx"
   '.InitialFileName = fType '初始化文件路径/名称/类型
   '.Filters.Add "Microsoft Excel 文件", "*.xlsx" '方式2：添加项目
   'Filters.Delete .Filters.Count '删除添加项目

   '其它代码......
End With

kutmis

lss001 发表于 2024-12-4 19:29
With Application.FileDialog(2)
                .InitialView = 1 '初始化视图 ...

好像就方式1管用，方式2没啥变化

kutmis

关键我在wps里用fd.filters.clear会报错，没在ms office里试

opiona

1. Rem *************************************************************************************************************
   
2. Rem 选择单个文件：    GetFileName
   
3. Rem 功能：                  获得已经选择文件全路径,没选择的，返回：空白
   
4. Rem 参数：KZM           可选，默认是："Excel文件,*.xls;*.xlsx;*.xlsm"
   
5. Rem 参数：Title            可选，提示信息，默认是：北极狐工作室
   
6. Rem 参数：Filename     可选，开始文件夹，默认是：本表所在文件夹
   
7. Rem 参数：StrSplitor     可选，各级文件夹分隔符
   
8. Rem 使用方法： PathY = GetFileName(KZM:="Excel文件,*.xls,*.xlsx;*.xlsm", Title:="请选择Excel文件", filename:="", StrSplitor:="")
   
9. Rem 作者：       北极狐工作室 QQ：14885553
   
10. Rem *************************************************************************************************************
    
11. Public Function GetFileName(Optional ByVal KZM = "Excel文件,*.xls;*.xlsx;*.xlsm", Optional ByVal Title As String = "", Optional ByVal filename As String = "", Optional ByVal StrSplitor As String = "") As String
    
12.     Dim X As Long
    
13.     Dim ARX
    
14.    
    
15.     Rem 为了解决WPS 不出现对话框 需要加一对: Application.ScreenUpdating
    
16.     Dim BLApp As Boolean
    
17.     BLApp = Application.ScreenUpdating
    
18.     Application.ScreenUpdating = False
    
19.    
    
20.     Rem 默认的分隔符号
    
21.     If StrSplitor = "" Then StrSplitor = ""
    
22.    
    
23.     If filename = "" Then filename = ThisWorkbook.Path
    
24.     Rem 如果文件夹路径 最后不是：[\] 则补充上去
    
25.     If Right(filename, 1) <> StrSplitor Then filename = filename & StrSplitor
    
26.     With Application.FileDialog(msoFileDialogFilePicker)
    
27.         .Filters.Clear   '清除文件过滤器，注意顺序
    
28.         If InStr(KZM, ",") > 0 Then
    
29.             Rem KZM="Excel2003,*.xls|Excel2007,*.xlsx;*.xlsm|WORD文件,*.doc;*.docx"
    
30.             Rem KZM="图片文件,*.png;*.bmp;*.jpeg;*.jpg"
    
31.             ARX = Split(KZM, "|")
    
32.             For X = 0 To UBound(ARX)
    
33.                 .Filters.Add Split(ARX(X), ",")(0), Split(ARX(X), ",")(1)
    
34.             Next
    
35.         End If
    
36.         Rem 注意顺序
    
37.         .Filters.Add "所有文件", "*.*", 1    '增加筛选器的项目为所有文件
    
38.         .AllowMultiSelect = False    '不允许多项选择
    
39.         .InitialFileName = filename    '//设置默认文件夹
    
40.         If Title = "" Then   '//设置提示信息
    
41.             .Title = "北极狐工作室： 请选择文件存放的路径（文件夹）"    '自定义浏览对话框的标题栏名称，默认：“浏览”
    
42.         Else
    
43.             .Title = Title
    
44.         End If
    
45.         If .Show = -1 Then
    
46.             GetFileName = .SelectedItems(1)
    
47.         Else
    
48.             GetFileName = ""
    
49.         End If
    
50.     End With
    
51.     Application.ScreenUpdating = BLApp
    
52. End Function

复制代码

RMans

学习下大佬的代码