strip macros from new xlsx file

问题

FUNCTIONAL PORTION: The code below saves 2 tabs from an xlsm file to a new xlsx file. the file stays open for editing.

ERROR: The xlsm tab has a trigger in the sheet code. That trigger is invalid and causes an error as soon as anything is entered in the xlsx sheet.

DESIRED OUTPUT: no error generated when editing the new file

FAILED FIX ATTEMPT: I tried to use Scripting to delete the macros but the brand new sheet doesn't give access to its code. I might have done that wrong...

Sub seedPro()
    
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    
    Dim wb2 As Workbook ' for new workbook
    
    ' make new sheet/names
    Worksheets(Array("Pro Focus", "AF-LU")).Copy
    
    Set wb2 = ActiveWorkbook
    wb2.SaveAs Filename:="New Form.xlsx", FileFormat:=xlOpenXMLWorkbook
        
End Sub

Below is the sheet macro that triggers on editing the new xlsx Saved in Pro Focus tab

Private Sub Worksheet_Change(ByVal target As Range)
    If target.Address = "$C$2" And Not target.Value = "Company" Then
        newProspect "focus" ' causes error because this is not found in the xlsx
    End If
End Sub

回答1:

the file stays open for editing.

There are two ways that I can immediately think of to handle this situation.

Way 1

You need to close and re-open the newly created file.

Option Explicit

Sub WayOne()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    wb.Worksheets(Array("Pro Focus", "AF-LU")).Copy
    
    Dim wb2 As Workbook
    Set wb2 = Application.Workbooks.Item(Application.Workbooks.Count)
    
    Dim FilePath As String
    FilePath = "C:\SampleFolder\New Form.xlsx"
    
    Application.DisplayAlerts = False
    wb2.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    
    wb2.Close (False)
    
    Set wb2 = Workbooks.Open(FilePath)
End Sub

Way 2

Delete the VBA code from the newly created file. For this you need to ensure that Trust access to the VBA project object model is checked by doing the following

1. Click File --> Options.
2. In the navigation pane, select Trust Center.
3. Click Trust Center Settings....
4. In the navigation pane, select Macro Settings.
5. Ensure that Trust access to the VBA project object model is checked.
6. Click OK.

Code:

Option Explicit

Sub WayTwo()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    
    wb.Worksheets(Array("Pro Focus", "AF-LU")).Copy
    
    Dim wb2 As Workbook
    Set wb2 = Application.Workbooks.Item(Application.Workbooks.Count)
    
    Dim FilePath As String
    FilePath = "C:\SampleFolder\New Form.xlsx"
        
    Application.DisplayAlerts = False
    wb2.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    
    Dim i As Long

    On Error Resume Next
    With wb2.VBProject
        For i = .VBComponents.Count To 1 Step -1
            .VBComponents.Remove .VBComponents(i)
            .VBComponents(i).CodeModule.DeleteLines _
            1, .VBComponents(i).CodeModule.CountOfLines
        Next i
    End With
    On Error GoTo 0
End Sub

Note: I prefer Way 1 but then that is just my personal preference.

回答2:

You could delete the sheetChange event script from the original sheet and set it on the Workbook instead, that way the sheet is clean and you can copy it easily. Put this in your ThisWorkbook scripts page:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    set Sh = worksheets(1) 'HERE you choose the worksheet where you want to run this code
    If Sh.target.Address = "$C$2" And Not Sh.target.Value = "Company" Then
        newProspect "focus" ' causes error because this is not found in the xlsx
    End If
End Sub

来源：https://stackoverflow.com/questions/65269632/strip-macros-from-new-xlsx-file