ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 524|回复: 4

[求助] 怎么禁止导入时的弹窗提示

[复制链接]

TA的精华主题

TA的得分主题

发表于 2023-1-14 22:20 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
在用wps2019专业版打开excel的xlsm文件后,用其中的导入功能导入分表时,会弹窗提示,点击是才能继续导入,怎么修改代码,在WPS中可以避免弹窗提示,直接导入呢?


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



TA的精华主题

TA的得分主题

发表于 2023-1-15 08:27 | 显示全部楼层
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

TA的精华主题

TA的得分主题

发表于 2023-1-15 08:28 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2023-1-15 12:29 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

还是弹出文件扩展名不一致的提示,看来是wps的问题,excel2013没有问题
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-19 18:32 , Processed in 0.027090 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表