Question

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

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

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

Answer 2

除非提供更多信息，否则我的猜测是引用了Microsoft Visual Basic for Applications Extensibility＃。＃＆＃39;未在＆＃39;工具＆＃39; |＆＃39;参考＆＃39;中选择或者在代码中手动添加。

http://www.cpearson.com/excel/vbe.aspx

我按原样复制了你的代码，代码在VBProj的声明中打破了VBIDE.VBProject。一旦我引用上述参考，代码就会执行。

另存为并禁用公式和宏

2 个答案: