excel - 另存为并禁用公式和宏

Question

我想制作一个 VBA 代码以保存在 map 中，并关闭所有公式和宏。

这是我到目前为止所想到的，但它不起作用。

Sub Opslaanzonderformules()
  Dim strFileName As Variant, strPath As String
  Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & [AJ2], _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
    MsgBox "Oh oh... je hebt niet opgeslagen! "
  Else
    ActiveSheet.Copy
    With ActiveWorkbook
        With .Sheets("blad1")
            .Unprotect
            .UsedRange.Value = .UsedRange.Value
            .Protect
        End With
     Set VBProj = .VBProject
     For Each VBComp In VBProj.VBComponents
            If VBComp.Type = vbext_ct_Document Then
                Set CodeMod = VBComp.CodeModule
                With CodeMod
                    .DeleteLines 1, .CountOfLines
                End With
            Else
                VBProj.VBComponents.Remove VBComp
            End If
        Next VBComp
    .SaveAs Filename:=strFileName
End With
  MsgBox "Gelukt!  Opgeslagen als: " & strFileName

  End If
End Sub

Answer 1

如果将文件另存为 xlsx，则所有代码都会自动删除。简化为:

Sub Opslaanzonderformules()
  Dim strFileName As Variant, strPath As String
  Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule
  strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & [AJ2], _
                                              FileFilter:="Excel Files (*.xls), *.xls, Excel 2007 Files (*.xlsm), *.xslm", _
                                              FilterIndex:=1, _
                                              Title:="Kies de juiste map en pas eventueel de bestandsnaam aan!")
  If strFileName = False Then
      MsgBox "Oh oh... je hebt niet opgeslagen! "
  Else
      ActiveSheet.Copy
      With ActiveWorkbook
            With .Sheets(1)
               .Unprotect
               .UsedRange.Value = .UsedRange.Value
               .Protect
            End With
      .SaveAs Left$(strFileName, InStrRev(strFileName, ".")) & "xlsx", xlOpenXMLWorkbook
      End With
  MsgBox "Gelukt!  Opgeslagen als: " & Left$(strFileName, InStrRev(strFileName, ".")) & "xlsx"
  End If
End Sub