Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2259|回复: 6

[已解决]如何选取文件夹删除下面的工作簿模块

[复制链接]
发表于 2012-4-22 17:09 | 显示全部楼层 |阅读模式
如何选取文件夹,依次打开下面所有的工作簿,禁用里面宏的情况下,删除工作簿内指定名称的模块和删除指定隐藏了的工作表,并不提示即保存。

如何实现,希望各位给段代码
最佳答案
2012-4-22 19:55
  1. Sub test()
  2.     Application.ScreenUpdating = False
  3.     Application.EnableEvents = False
  4.     Application.DisplayAlerts = False
  5.     On Error Resume Next
  6.     Set Myf = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件目录:", &H1)
  7.     If Not Myf Is Nothing Then
  8.         Directory = Myf.self.Path
  9.     End If
  10.     MyName = Dir(Directory & "\*.xls")
  11.     Do While MyName <> ""
  12.         Workbooks.Open (Directory & "" & MyName)
  13.         With ActiveWorkbook
  14.         '***********删除工作表和宏
  15.         .Sheets("Sheet1").Delete     '删除工作表
  16.            '**删除各模块内容
  17.         With .VBProject.VBComponents("ThisWorkbook").CodeModule
  18.             .DeleteLines 1, .CountOfLines
  19.         End With
  20.         With .VBProject.VBComponents("模块1").CodeModule
  21.             .DeleteLines 1, .CountOfLines
  22.         End With
  23.         With .VBProject.VBComponents("UserForm1").CodeModule
  24.             .DeleteLines 1, .CountOfLines
  25.         End With
  26.         With .VBProject.VBComponents("sheet1").CodeModule
  27.             .DeleteLines 1, .CountOfLines
  28.         End With
  29.             '**删除模块
  30.         .VBProject.VBComponents.Remove .VBProject.VBComponents("模块1")
  31.         '*****************
  32.         .Close True
  33.         End With
  34.         MyName = Dir
  35.     Loop
  36.     Application.EnableEvents = True
  37.     Application.DisplayAlerts = True
  38.     Application.ScreenUpdating = True
  39. End Sub

复制代码
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2012-4-22 18:34 | 显示全部楼层
回复

使用道具 举报

发表于 2012-4-22 18:45 | 显示全部楼层
本帖最后由 zjdh 于 2012-4-22 18:50 编辑

若文件加锁或VBA加密码保护,则不提供密码就无法删除了。
回复

使用道具 举报

发表于 2012-4-22 18:47 | 显示全部楼层
本帖最后由 zjdh 于 2012-4-22 18:49 编辑

重复啦{:101:}            .
回复

使用道具 举报

 楼主| 发表于 2012-4-22 19:06 | 显示全部楼层
zjdh 发表于 2012-4-22 18:45
若文件加锁或VBA加密码保护,则不提供密码就无法删除了。

没密码,或者密码一致
回复

使用道具 举报

发表于 2012-4-22 19:55 | 显示全部楼层    本楼为最佳答案   
  1. Sub test()
  2.     Application.ScreenUpdating = False
  3.     Application.EnableEvents = False
  4.     Application.DisplayAlerts = False
  5.     On Error Resume Next
  6.     Set Myf = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件目录:", &H1)
  7.     If Not Myf Is Nothing Then
  8.         Directory = Myf.self.Path
  9.     End If
  10.     MyName = Dir(Directory & "\*.xls")
  11.     Do While MyName <> ""
  12.         Workbooks.Open (Directory & "" & MyName)
  13.         With ActiveWorkbook
  14.         '***********删除工作表和宏
  15.         .Sheets("Sheet1").Delete     '删除工作表
  16.            '**删除各模块内容
  17.         With .VBProject.VBComponents("ThisWorkbook").CodeModule
  18.             .DeleteLines 1, .CountOfLines
  19.         End With
  20.         With .VBProject.VBComponents("模块1").CodeModule
  21.             .DeleteLines 1, .CountOfLines
  22.         End With
  23.         With .VBProject.VBComponents("UserForm1").CodeModule
  24.             .DeleteLines 1, .CountOfLines
  25.         End With
  26.         With .VBProject.VBComponents("sheet1").CodeModule
  27.             .DeleteLines 1, .CountOfLines
  28.         End With
  29.             '**删除模块
  30.         .VBProject.VBComponents.Remove .VBProject.VBComponents("模块1")
  31.         '*****************
  32.         .Close True
  33.         End With
  34.         MyName = Dir
  35.     Loop
  36.     Application.EnableEvents = True
  37.     Application.DisplayAlerts = True
  38.     Application.ScreenUpdating = True
  39. End Sub

复制代码
回复

使用道具 举报

发表于 2012-4-22 19:58 | 显示全部楼层
可根据需要选用相关语句,删除工作表,删除宏还是删除模块。
楼上语句在2003版测试通过。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 09:23 , Processed in 0.397304 second(s), 8 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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