Board logo

標題: [分享] 另存新檔時去除檔案中所有程式碼 [打印本頁]

作者: Min    時間: 2010-5-9 21:05     標題: 另存新檔時去除檔案中所有程式碼

Option Explicit
Sub CleanVBComponents()
    Dim objVBC As Object
    Dim objMdl As Object
    Dim arr() As Variant
    Dim intCounter As Integer
    Dim txt As String
    Dim fileSaveName As Variant
    Dim Msg As String
    Dim ctl As Shape

    Msg = "另存檔案"
    ChDir ThisWorkbook.Path

    fileSaveName = Application.GetSaveAsFilename( _
            FileFilter:="Excel Files (*.xls), *.xls", Title:=Msg)

    If fileSaveName = False Then Exit Sub
    Application.ScreenUpdating = False

    For Each ctl In Sheet1.Shapes
        ctl.Delete
    Next ctl

    ReDim arr(1 To 3, 1 To ActiveWorkbook.VBProject.VBComponents.Count)
    intCounter = 0
    Application.StatusBar = "刪除VBE程式碼..."
    For Each objVBC In ActiveWorkbook.VBProject.VBComponents
        Set objMdl = objVBC.CodeModule
        intCounter = intCounter + 1

        arr(1, intCounter) = objVBC.Type

        arr(2, intCounter) = objVBC.Name
        If objMdl.countoflines > 0 Then
            txt = objVBC.CodeModule.Lines(1, objMdl.countoflines)
        End If
        arr(3, intCounter) = txt
        Select Case arr(1, intCounter)
            Case 1
                ActiveWorkbook.VBProject.VBComponents.Remove objVBC
            Case 2
                ActiveWorkbook.VBProject.VBComponents.Remove objVBC
            Case 100
                objVBC.CodeModule.DeleteLines 1, objMdl.countoflines
            Case 3
                ActiveWorkbook.VBProject.VBComponents.Remove objVBC
                DoEvents
        End Select
    Next objVBC
    ThisWorkbook.SaveAs fileSaveName
    Application.ScreenUpdating = True
    Application.StatusBar = ""
End Sub
作者: PD961A    時間: 2010-5-10 07:44

請問閔版主
這段文章
針對的是另存新檔時
刪掉全部的程式碼....
(模組全刪掉不是也可以?)
另外如果只要刪一半那不就要重寫?
謝謝!!
作者: Min    時間: 2010-5-10 09:45

是另存新檔時 將新檔刪除!
亦可改為 唯讀 並將原檔刪除...
如果debug過程中誤刪除 呵呵呵~ 那請節哀...
作者: PD961A    時間: 2010-5-10 13:11

是另存新檔時 將新檔刪除!
亦可改為 唯讀 並將原檔刪除...
如果debug過程中誤刪除 呵呵呵~ 那請節哀...
Min 發表於 2010-5-10 09:45


閔板主
您幽默了
如果debug過程中誤刪除 呵呵呵~ 那請節哀...

要刪檔前(或另存新檔前)
先備份舊檔.......(節哀沒用的....神仙難救!!)
謝謝!!
作者: freeffly    時間: 2012-1-30 12:01

回復 1# Min


    之前我都是手動刪除
   這個程式碼我有用到
   不過我還是研究依下
   謝謝分享
作者: junyen711    時間: 2012-1-30 22:56

回復 1# Min
這個有用, 加進文件來試試效果
作者: homeman    時間: 2012-1-31 00:04

我都是執行完畢後, 再手動刪除巨集碼, 這段可以好好的研究一翻, Thanks
作者: sillykin    時間: 2016-2-20 17:14

回復 1# Min


上述程式試過,另存一個無vba程式碼,產生原始檔(有vba碼)、另存新檔(無vba碼)共存   
想請問要如何僅留存〔另存新檔檔案(無vba碼)〕,另將原始檔刪掉,並在垃圾桶也找不到,這要如何寫呢??
作者: sillykin    時間: 2016-2-20 23:51

回復 8# sillykin


    上述之程式碼為VBAProject未設定密碼時可使用
一但設定密碼時,就無法使用,可否在上述程式碼中加入VBAProject密碼,是否可行呢???
作者: PKKO    時間: 2016-2-25 22:52

感謝,有幫助+1




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)