另存新檔時去除檔案中所有程式碼

sillykin

另存新檔時去除檔案中所有程式碼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
  上述之程式碼為VBAProject未設定密碼時可使用
一但設定密碼時,就無法使用，可否在上述程式碼中加入VBAProject密碼，是否可行呢？？？求解..急用