怎么禁止导入时的弹窗提示

hhxq001

在用wps2019专业版打开excel的xlsm文件后，用其中的导入功能导入分表时，会弹窗提示，点击是才能继续导入，怎么修改代码，在WPS中可以避免弹窗提示，直接导入呢？


怎么可以禁止弹出导入提示1.zip (641.98 KB, 下载次数: 8)

2023-1-14 22:20 上传

点击文件名下载附件

3190496160

Private Sub CommandButton9_Click()
    Dim sh As Worksheet
    Dim AK As Workbook, aRow%, tRow%, bRow%, i As Integer
    Dim 文件集合 As Object
    Dim 文件名 As Variant
   
    Application.ScreenUpdating = False
   Application.DisplayAlerts = False
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "----------请选中一个或多个文件："           '选择框标题名称
        .InitialFileName = ThisWorkbook.Path & "\"            '默认打开当前目录
        
        .Filters.Clear
        .Filters.Add "选择Excel文件", "*.xls,*.xlsx,*.xlsm", 1   '查找目录下的xls和xlsx、xlsm文件
        
         If .Show = 0 Then MsgBox "本次没有选择任何文件": Exit Sub
         Set 文件集合 = .SelectedItems
         ActiveSheet.Unprotect ("123") '汇总表先取消保护
    End With
   
    Dim tim
    tim = Timer '计时开始
   
     For Each 文件名 In 文件集合   '依次找寻指定路径中的*.xls文件，当指定路径中有文件时进行循环
        If Not 文件名 Like "*" & ThisWorkbook.Name & "*" Then '就执行后面的代码
            Set AK = GetObject(文件名) '用只读方式GetObject读取文件比 Workbooks.Open快点
            
            '以下只针对一个工作表进行复制
            aRow = AK.Sheets(1).Range("a65536").End(xlUp).Row + 1
            tRow = ThisWorkbook.Sheets("登记").Range("a65536").End(xlUp).Row + 1
            
            AK.Sheets(1).Range("a2:i" & aRow).Copy '复制分表信息
            ThisWorkbook.Sheets("登记").Range("a" & tRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'PasteSpecial Paste:=xlPasteValues '只粘贴数值到汇总表的最后
                  
            Application.CutCopyMode = False '取消应用程序复制模式
            AK.Close False   '关闭源工作簿,并不作修改
         End If

    Next 文件名  '循环到下一个*.xls文件
   
  bRow = ActiveSheet.Range("a65536").End(xlUp).Row
  With ActiveSheet

      .Range("a2:i7001").Borders.LineStyle = 1 '设置边框
      .Range("a2:h7001").Font.Name = "微软雅黑" '设置字体
      .Range("a2:h7001").Font.Size = 10 '设置字体大小
      .Range("a2:h7001").ShrinkToFit = True '自动缩小字体以适应单元格
      .Range("a2:g7001").Font.ColorIndex = xlAutomatic '字体颜色=保持系统默认-黑色
      .Range("a2:h7001").VerticalAlignment = xlCenter '垂直对齐方式=上下居中
      .Range("a2:h7001").Locked = False '解除a2-g7001的锁定，方便编辑
      .[a2:a7001].HorizontalAlignment = xlCenter 'a列水平方式=水平居中
      .Range("b2:f7001").HorizontalAlignment = xlLeft  'b-f列水平方式=居左
      .Range("d2:d7001").HorizontalAlignment = xlRight 'd列水平方式=居右
      .Range("h2:h7001").HorizontalAlignment = xlCenter 'h列水平方式=水平居中
      .Range("a2:i7001").RowHeight = 18  '行宽
      .Columns("a:c").NumberFormatLocal = "@" '第1-3列单元格格式定义为文本格式
      .Columns("d").NumberFormatLocal = "0.00_ "  'd列单元格格式定义为数值
      .Range("i2:i7001").Font.Color = -16776961         'i列字体为红色

      .Range("a1:j1").AutoFilter Field:=1 '筛选模式可用
     
End With

Application.Goto Reference:=ActiveSheet.Range("b" & bRow & ": f" & bRow + 2), Scroll:=True '完成后鼠标跳转到最下行

'设置动态打印范围,这样生成的新表就自带打印预览分页线,可以拖拉蓝色的分页线进行打印区域的调整.
ActiveSheet.PageSetup.PrintArea = "A1:j" & bRow + 3
   
    ActiveWorkbook.Save '导入完成，自动保存一下工作簿
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    tim = Format(Timer - tim, "0.00")       '耗时多久
    MsgBox "OK，导入完成-用时：" & tim & "秒。", , "温馨提示"
   Set 文件名 = Nothing
  
End Sub

3190496160

怎么可以禁止弹出导入提示1.rar (635.74 KB, 下载次数: 7)

2023-1-15 08:27 上传

点击文件名下载附件

hhxq001

3190496160 发表于 2023-1-15 08:28

还是弹出文件扩展名不一致的提示，看来是wps的问题，excel2013没有问题