12
返回列表 上一主題 發帖

[發問] 刪除指定資料夾中所有巨集

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-6-8 16:38 | 只看該作者

[發問] 刪除指定資料夾中所有巨集

請教高手:
VBA TEST 6_刪除所有巨集.zip (281.2 KB)

我要在Cancel VBA.xlsm的E6儲存格中指定一個資料夾名稱為"刪除所有巨集",
1) 只要是放在這個資料夾中的所有檔案,一律刪除所有巨集(不論EXCEL檔案中有多少巨集)
2) 資料夾中的EXCEL檔案類型有.xls/.xlsm

這樣的要求是否可寫成一個巨集?

VBA TEST 6_刪除資料夾中巨集.zip (93.08 KB)

收藏 分享

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
13#
發表於 2013-3-13 12:29 | 只看該作者
回復 12# GBKEE

感謝大大, 原來是設定問題,解決了!!

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2013-3-13 12:15 | 只看該作者
回復 11# PJChen
勾選它

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
11#
發表於 2013-3-13 11:19 | 只看該作者
回復 9# Hsieh

版大,
最近我的電腦重新安裝Ms office 2010,之前使用的這個巨集,突然無法運作並出現"錯誤1004",可以幫忙看下是出了什麼問題?或者我需要再提供什麼訊息? 感謝!!

Cancel VBA.zip (18.84 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
10#
發表於 2012-6-12 17:41 | 只看該作者
回復 9# Hsieh
也許我誤以為簡體字檔名為無巨集便會停下來,現在測試未發現有問題了,不過想請教,為何將檔名顯示在[A1]儲存格,為何它就可以接受簡體字了?

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2012-6-12 15:17 | 只看該作者
本帖最後由 Hsieh 於 2012-6-12 16:36 編輯

回復 8# PJChen
1. 並無你所說當無程式碼檔案執行時會停止的現象
2. 要正確顯示檔名，只能借用儲存格顯示
  1. Sub Try()
  2. Dim fs
  3. Application.DisplayAlerts = False
  4. fd = ThisWorkbook.Path & "\" & Sheets(1).[E6] '檔案目錄
  5. Set fos = CreateObject("Scripting.FileSystemObject")
  6. Set fdn = fos.getfolder(fd)
  7. Set fc = fdn.Files '檔案目錄中所有檔案
  8. For Each fs In fc
  9. [A1] = fs.Name '借用儲存格顯示正確檔名
  10. With Workbooks.Open(fd & "\" & [A1].Text, 0) ' 開啟檔案不更新連結
  11. For Each vbc In .VBProject.VBComponents
  12.   Select Case vbc.Type
  13.   Case 100
  14.     .VBProject.VBComponents(vbc.Name).CodeModule.DeleteLines 1, _
  15.     .VBProject.VBComponents(vbc.Name).CodeModule.CountOfLines '刪除所有程式碼
  16.   Case Else
  17.     .VBProject.VBComponents.Remove .VBProject.VBComponents.Item(vbc.Name) '移除模組、表單、類別模組
  18.   End Select
  19. Next
  20. .Close 1
  21. End With
  22. Next
  23. End Sub
複製代碼
學海無涯_不恥下問

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
8#
發表於 2012-6-12 08:45 | 只看該作者
回復 6# Hsieh

再補充問題,程式執行時是否會因為簡體字而無法執行,像以下的檔名,它就出現了這樣的訊息:
6月11日出车表.xls

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
7#
發表於 2012-6-12 08:39 | 只看該作者
回復 6# Hsieh
請問大大,
若是待刪除巨集的檔案中有些是完全沒有巨集的(程式會停下來),我要讓"刪除巨集"的程式忽略它,繼續執行指令刪除其它有巨集的檔案,
我應該加入什麼語言(加在什麼地方)?才能達成我想要的?

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2012-6-12 08:19 | 只看該作者
回復 5# PJChen


    開啟檔案不更新連結
  1. Sub Try()
  2. fd = ThisWorkbook.Path & "\" & Sheets(1).[E6] & "\"
  3. fs = Dir(fd & "*.xlsm")
  4. fs = Dir(fd & "*.xls")
  5. Do Until fs = ""
  6. Application.DisplayAlerts = False
  7. With Workbooks.Open(fd & fs, False)  ' 開啟檔案不更新連結
  8. 'With Workbooks.Open(fd & fs, True)  ' 開啟檔案更新連結

  10. For Each vbc In .VBProject.VBComponents
  11.   Select Case vbc.Type
  12.   Case vbext_rk_Project, vbext_wt_Browser, vbext_ct_MSForm '註
  13.     .VBProject.VBComponents.Remove .Item(vbc.Name)

  15.   Case Else
  16.     .VBProject.VBComponents(vbc.Name).CodeModule.DeleteLines 1, _
  17.     .VBProject.VBComponents(vbc.Name).CodeModule.CountOfLines

  19.   End Select
  20. Next
  21. .Close 1
  22. End With
  23. fs = Dir
  24. Loop
  25. End Sub
複製代碼
學海無涯_不恥下問

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
5#
發表於 2012-6-12 08:11 | 只看該作者
回復 2# Hsieh
版大,
在程式執行過程中,它會一直出現對話框問是否更新連結?我想到之前大大給的二句話(藍色字),就將它加在這個程式中,但執行時停在With Workbooks.Open(fd & fs),是否前述二句話放錯位置了?
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
  1. Sub Try()
  2. fd = ThisWorkbook.Path & "\" & Sheets(1).[E6] & "\"
  3. fs = Dir(fd & "*.xlsm")
  4. fs = Dir(fd & "*.xls")
  5. Do Until fs = ""
  6. Application.DisplayAlerts = False
  7. Application.AskToUpdateLinks = False
  8. With Workbooks.Open(fd & fs)
  9. For Each vbc In .VBProject.VBComponents
  10.   Select Case vbc.Type
  11.   Case vbext_rk_Project, vbext_wt_Browser, vbext_ct_MSForm '註
  12.     .VBProject.VBComponents.Remove .Item(vbc.Name)

  14.   Case Else
  15.     .VBProject.VBComponents(vbc.Name).CodeModule.DeleteLines 1, _
  16.     .VBProject.VBComponents(vbc.Name).CodeModule.CountOfLines

  18.   End Select
  19. Next
  20. .Close 1
  21. End With
  22. fs = Dir
  23. Loop
  24. End Sub
複製代碼

TOP

        靜思自在 : 多做多得。少做多失。
12
返回列表 上一主題