Сохраните две указанные c таблицы в новой книге без формул, но сохраняя дизайн

Question

У меня есть рабочая тетрадь, в которой я создаю кнопку, которая позволяет сохранять два указанных c листа без формул (цель заключается в том, что листы будут отправлены партнерам и заказчикам). Я хотел бы, чтобы листы были сохранены в одном документе где-то на моем компьютере, и при этом иметь текущий «дизайн» с цветами, setup et c.

В настоящее время я написал этот код, который выполняет все, что я описал, кроме удаления формул ...

Sub SaveAsValues()
Dim ws As Worksheet

Worksheets(Array("frontpage", "mobile")).Copy After:= ws.Worksheets

With ActiveWorkbook
.SaveAs Filename:= "C:XXXX" & "NAME", FileFormat:= xlOpenXMLWorkbook
.Close savechanges = False
End With
End Sub

Надеюсь, вы можете помочь: -)

Answer 1

У меня есть лист, для которого я использую что-то похожее, я немного скорректирую код для работы с вашим сценарием. Если вы не хотите, чтобы настройки изменялись, удалите подпрограммы TurnOnFunctions & TurnOffFunctions.

Этот код будет только разрывать ссылки, а не все формулы. Таким образом, если формула ссылается на другую электронную таблицу, она будет иметь значение c; однако, если это простая формула, которая остается в электронной таблице, она останется такой же.

Также добавьте название своей рабочей книги в соответствующую область.

Sub NewWorkbooks()
'This will make seperate workbooks for each of the tabs listed
Dim wb As Workbook
Dim NewBook As Workbook
Dim ws As Worksheet

Call TurnOffFunctions
Set wb = ActiveWorkbook

For Each ws In Workbooks("YOUR WORKBOOK NAMR"). _
Worksheets(Array("frontpage", "mobile"))
        ws.Copy
        Set NewBook = ActiveWorkbook
        With NewBook
            Call break_links(NewBook)
            .SaveAs Filename:="C:XXXX" & "NAME", FileFormat:=xlOpenXMLWorkbook
            .Close SaveChanges:=False
        End With
Next

Call TurnOnFunctions

End Sub
Sub break_links(ByRef wb As Workbook)
Dim Links As Variant
On Error Resume Next
Links = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
On Error GoTo 0

If Not IsEmpty(Links) Then
    For i = 1 To UBound(Links)
        wb.BreakLink _
        Name:=Links(i), _
        Type:=xlLinkTypeExcelLinks
    Next i
End If

End Sub
Private Sub TurnOffFunctions()

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

End Sub
Private Sub TurnOnFunctions()

    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

Вы также можете использовать свою с этот мод (не проверено):

Sub SaveAsValues()
Dim ws As Worksheet

Worksheets(Array("frontpage", "mobile")).Copy After:= ws.Worksheets

Call break_links ActiveWorkbook

With ActiveWorkbook
.SaveAs Filename:= "C:XXXX" & "NAME", FileFormat:= xlOpenXMLWorkbook
.Close savechanges = False
End With
End Sub

Sub break_links(ByRef wb As Workbook)
Dim Links As Variant
On Error Resume Next
Links = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
On Error GoTo 0

If Not IsEmpty(Links) Then
    For i = 1 To UBound(Links)
        wb.BreakLink _
        Name:=Links(i), _
        Type:=xlLinkTypeExcelLinks
    Next i
End If

End Sub