Как сохранить файл excel без макросов - Word и Excel - помощь в работе с программами

PATRI0T

Пользователь

Сообщений: 5
Регистрация: 13.11.2015

05.10.2017 11:28:30

Добрый день.
В Excel сделал небольшую форму для приема заказов на мебельном производстве.
И потом заявку нужно сохранить в отдельном .xls файле , для импорта в другую программу.
Код макроса содержится на листе + отдельный модуль…
На листе обработчик на событие Workbook_Open

Что делаю:
1.Копирую текущий лист в новую книгу, удаляю все лишнее на листе (управляющие кнопки (shape), лишние строки .итд)
2. Удаляю макросы (внизу код)
3. сохраняю как файл .xls (xlExcel8)

Код

Sheets("Новый Заказ").Copy
Call Delete_Macroses
ActiveWorkbook.SaveAs FileName:=ПутьСохранения & "" & Fname, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

Этой процедурой удаляю макросы (пытаюсь)

Код

Sub Delete_Macroses()
    Dim oVBComponent As Object, lCountLines As Long
    'Проверяем, защищен проект или нет
 
    For Each oVBComponent In ActiveWorkbook.VBProject.VBComponents
        On Error Resume Next
        With oVBComponent
            Select Case .Type
            Case 1    'Модули
                .Collection.Remove oVBComponent
            Case 2    'Модули Класса
                .Collection.Remove oVBComponent
            Case 3    'Формы
                .Collection.Remove oVBComponent
            Case 100    'ЭтаКнига, Листы
                    lCountLines = .CodeModule.CountOfLines
                    .CodeModule.DeleteLines 1, lCountLines
            End Select
        End With
    Next
    Set oVBComponent = Nothing
End Sub

В результате
Файл занимает 52 КБ, а не 9, как если бы я сохранил его вручную в формат .xls
И при открытии всплывает сообщение «включить содержимое».

Что не так? Что не удаляется?

Вопрос.
А можно ли сохранить заявку из этого файла без макросов, не прибегая к обращению к объектной модели?
Т.к. этот файлик рассылается клиентам, и нужно обязательно делать соотв. настройки у них..
А клиенты разные и нервные.. Можно ли как-то этого избежать?

Прикрепленные файлы

2017-10-05_110247.png (22.83 КБ)
Иванов 444. (от 05.10.2017 11.08.50).xls (55.5 КБ)

_Igor_61 Пользователь Сообщений: 3007 Регистрация: 18.07.2016	Можно. Побаловался макрорекордером и у меня получилось

PATRI0T

Пользователь

Сообщений: 5
Регистрация: 13.11.2015

06.10.2017 08:17:17

Спасибо за ответ
Только я ничего не понял, почему у меня не работает. Вроде код такой же

А зачем это?

Код
Kill Addr & "Файл без макросов 2007.xlsx

Александр П.

Пользователь

Сообщений: 1147
Регистрация: 16.03.2016

06.10.2017 08:53:07

PATRI0T, Код ниже удаляет весь код во всех модулях активной книги.

Код
Sub test() Set VBComp = ActiveWorkbook.VBProject.VBComponents For Each cl In VBComp cl.CodeModule.DeleteLines 1, cl.CodeModule.CountOfLines Next End Sub

_Igor_61

Пользователь

Сообщений: 3007
Регистрация: 18.07.2016

06.10.2017 09:07:38

Цитата
PATRI0T написал: не понял, почему у меня не работает.

Покажите Ваш файл с кодом, который не работает. Смею предположить, что Вы что-то не так или не туда вставили или что-то не так сделали, а так же невнимательно посмотрели код, иначе не возникло бы вопроса:[QUOTE]PATRI0T написал: А зачем это? Kill Addr & «Файл без макросов 2007.xlsx[/CODE]
В модуле к этой и еще к нескольким строкам есть комментарии.
Так же обратите внимание на названия файлов в коде. Мои названия поменяйте на Ваши

_Igor_61

Пользователь

Сообщений: 3007
Регистрация: 18.07.2016

Александр, здравствуйте! Но тогда пользователю нужно лезть в параметры, ставить доверенный доступ и перезапускать приложение, что для пользователя, думаю не очень удобно. Поэтому по-моему проще это все сделать просто пересохранением файлов, а потом лишний файл удалить. ИМХО, конечно

	_Igor_61, ну так, наше дело предложить вариант . У ТСа так же, может быть только 2003 версия офиса, без конвертера. Тогда в .xlsx он не сможет сохранять. А так, была уже похожая тема на форуме. Изменено: Александр П. — 06.10.2017 10:19:58

sokol92 Пользователь Сообщений: 4445 Регистрация: 10.09.2017	Уважаемый PATRI0T, в приложенном к сообщению файле макросов нет, зато есть два «битых» имени книги. Удалите их через «Диспетчер имен» и проблема с открытием должна уйти.

_Igor_61

Пользователь

Сообщений: 3007
Регистрация: 18.07.2016

07.10.2017 00:34:38

Цитата
Александр П. написал: У ТСа так же, может быть только 2003 версия офиса

Да, если это так, то не удивительно, что у него мой макрос не работает, если он его в xls помещает. Но почему-то он про этот момент молчит. А я решил, что у него изначальный файл в xlsm, глядя на картинку

LAD Пользователь Сообщений: 22 Регистрация: 20.12.2015	Вы копируете лист со всеми потрохами. Копируйте только то, что Вам нужно. Сделайте новый лист и на него скопируйте диапазон ячеек. Изменено: LAD — 07.10.2017 04:58:21

RAN

Пользователь

Сообщений: 7091
Регистрация: 21.12.2012

#11

07.10.2017 09:48:49

Цитата
_Igor_61 написал: MsgBox «Блин, кажись, получилось…», 64, «ВАУ!»

_Igor_61, Вставьте это в модуль копируемого листа, и вау съедят мыши.

Код

Sub Мяу()
    Dim sfName1$, sfName2$
    Dim sh As Worksheet, nm As Name
    sfName1 = ThisWorkbook.FullName
    sfName1 = Replace(sfName1, "xlsm", "xlsx")
    sfName2 = Left(sfName1, Len(sfName1) - 1)
    Application.ScreenUpdating = False
    Application.CopyObjectsWithCells = False
    Sheets(Array(1, 3)).Copy
    For Each sh In ActiveWorkbook.Worksheets
        sh.UsedRange.Value = sh.UsedRange.Value
    Next
    For Each nm In ActiveWorkbook.Names
        nm.Delete
    Next
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs sfName1, 51
    ActiveWorkbook.Close False
    Workbooks.Open sfName1
    ActiveWorkbook.SaveAs sfName2, 56
    ActiveWorkbook.Close False
    Kill sfName1
    Application.DisplayAlerts = True
    Application.CopyObjectsWithCells = True

End Sub

Изменено: RAN — 07.10.2017 10:51:58

_Igor_61

Пользователь

Сообщений: 3007
Регистрация: 18.07.2016

RAN, не, не съедят, еще больше «ВАУ»!
Надеюсь, я тоже когда-то такие задачки буду сходу решать, но пока — изучаю VBA в основном на уровне макрорекордера, т.к. не хватает времени учебники читать. И в Вашем коде многое для меня — темный лес. Например, я не знаю, какую роль выполняет $ в названиях переменных sfName, также не понимаю, как и почему одной и той же переменной (стр.4 и 5) можно присвоить разные значения (или это функции — не знаю), ну и т.д. — короче, мне в этом коде понятны только строки после «Next», и то не все, например, не знаю что значат «51» и «56», ну и т.д. не буду все перечислять, т.к. для каждого моего вопроса придется делать отдельную тему
Ради интереса попробовал поместить Ваш код в файл xls, ошибка 400, новая книга с копируемым листом создается, но код в модуле листа остается.
А ТС пока так и молчит — из какой версии ему в xls нужно сохранять

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

$ в имени переменной — это тип (аналог as String). Вот табличка соответствий:
Integer — %
Long — &
Single — !
Doble — #
Currency — @
String — $
По поводу строк 4 и 5: сначала получили путь, а потом в этой строке произвели замену: xlsm заменили на xlsx. В принципе можно было и в одной строке сделать.
51 и 56 — это константы типов файлов.
===
// константы форматов 2003

// xlCSVWindows = 23;
// xlDBF2 = 7;
// xlDBF3 = 8;
// xlDBF4 = 11;
// xlDIF = 9;
// xlExcel9795 = 43;
// xlTextWindows = 20;
// xlUnicodeText = 42;
// xlWebArchive = 45;
// xlXMLSpreadsheet = 46;
// xlXMLData = 47;

// основные константы 2007
// These are the main file formats in Excel 2007-2010:
// 51 = xlOpenXMLWorkbook (without macro’s in 2007-2010, xlsx)
// 52 = xlOpenXMLWorkbookMacroEnabled (with or without macro’s in 2007-2010, xlsm)
// 50 = xlExcel12 (Excel Binary Workbook in 2007-2010 with or without macro’s, xlsb)
// 56 = xlExcel8 (97-2003 format in Excel 2007-2010, xls)

// 57 = PDF
// 60 = xlOpenDocumentSpreadsheet OpenDocument Spreadsheet

_Igor_61

Пользователь

Сообщений: 3007
Регистрация: 18.07.2016

Блин, как же я люблю этот форум! Каждый раз какое-то «ВАУ» для себя нахожу! Юрий М, спасибо большое! Сохранил Ваши пояснения, они очень пригодятся в дальнейшем. Не знал, что части кода можно цифрами задавать (хотя, нет, пример уже знаю — в MsgBox 64, 32, 48), это, видимо, что-то подобное, если правильно понимаю. Т.е. вместо «xlOpenXMLWorkbook (without macro’s in 2007-2010, xlsx) » пишем «51» и выполняется это действие, так? И я так понимаю, что RAN своим кодом вносит изменения в XML? Дальше — вообще не понимаю — ведь если открыть файл через WinRAR, там же куча папок и файлов XML, т.е. в данном случае через «51» производятся манипуляции с конкретным XML файлом, «51» его находит и выполняет свою задачу?

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле	XML тут нет ) Просто заменяем длинную строку числом )

_Igor_61 Пользователь Сообщений: 3007 Регистрация: 18.07.2016	xlOpenXMLWorkbook — тогда это просто указание на книгу xlsx 2007-2010, этим кодом ее открываем?

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле	Нет, открываем по имени, а это указание ТИПА файла — книга без макросов.

_Igor_61

Пользователь

Сообщений: 3007
Регистрация: 18.07.2016

А, кажется понял: ActiveWorkbook.SaveAs sfName1, 51 — сохраняем активную книгу с заданным именем (sfName1) в xlsx (xlOpenXMLWorkbook (without macro’s in 2007-2010, xlsx) . И равнозначно — можно записать текстом «xlOpenXMLWorkbook (without macro’s in 2007-2010, xlsx», а можно «51». Я правильно понимаю?
Простите за навязчивость, просто хочу правильно все уяснить для себя, чтобы все правильно понимать и в дальнейшем правильно использовать, если понадобится

Николай

Пользователь

Сообщений: 229
Регистрация: 01.01.1970

RAN,
Скопировал

ваш макрос

в личную книгу макросов.
Создал пустой файл Книга1.xlsm с 6 листами.
Открыл его и запустил ваш макрос.
Ошибка. Выделена строка.
ActiveWorkbook.SaveAs sfName1, 51
И табличка.

Что нужно изменить что бы макрос заработал из личной книги макросов. Из листа текущей книги отрабатывает корректно.

Изменено: Николай — 07.10.2017 19:42:37

Юрий М Модератор Сообщений: 60585 Регистрация: 14.09.2012 Контакты см. в профиле

_Igor_61 Пользователь Сообщений: 3007 Регистрация: 18.07.2016

RAN Пользователь Сообщений: 7091 Регистрация: 21.12.2012	sfName1 = ~~ThisWorkbook~~ ActiveWorkbook.FullName …………………………………….. ActiveWorkbook. Sheets(Array(1, 3)).Copy …………………………… Изменено: RAN — 07.10.2017 20:30:39

RAN Пользователь Сообщений: 7091 Регистрация: 21.12.2012	_Igor_61, F1, Search results for enumeration

Николай Пользователь Сообщений: 229 Регистрация: 01.01.1970	Кнопка цитирования не для ответа [МОДЕРАТОР] sfName1 = ActiveWorkbook.FullName Оказалось достаточно, работает.Но изменил и ActiveWorkbook. Sheets(Array(1, 3)).Copy Работает. Адаптирую под свои нужны отпишу.

Николай

Пользователь

Сообщений: 229
Регистрация: 01.01.1970

#25

07.10.2017 21:46:53

На тестовой книге.
Ошибка в строке
ActiveWorkbook.SaveAs sfName1, 51
При этом сохранение новой книги происходит.
Вот код.

Код

Sub кол_вх()
Dim s As String, fldr As String
fldr = "D:111"
s = Dir(fldr & "*.xls")
Do While s <> ""
    With Workbooks.Open(fldr & s)
    Dim sfName1$, sfName2$
    Dim sh As Worksheet, nm As Name
    sfName1 = ActiveWorkbook.FullName
    sfName1 = Replace(sfName1, "xlsm", "xlsx")
    sfName2 = Left(sfName1, Len(sfName1) - 1)
    Application.ScreenUpdating = False
    Application.CopyObjectsWithCells = False
    ActiveWorkbook.Sheets(Array(1, 2, 3, 4)).Copy
    For Each sh In ActiveWorkbook.Worksheets
        sh.UsedRange.Value = sh.UsedRange.Value
    Next
    For Each nm In ActiveWorkbook.Names
        nm.Delete
    Next
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs sfName1, 51
    ActiveWorkbook.Close False
    Workbooks.Open sfName1
    ActiveWorkbook.SaveAs sfName2, 56
    ActiveWorkbook.Close False
    Kill sfName1
    Application.DisplayAlerts = True
    Application.CopyObjectsWithCells = True
        .Close 0
    End With
    s = Dir
Loop
End Sub

И скрин ошибки.
Файла Книга1.xls в каталоге НЕТ.

Прикрепленные файлы

2017-10-07_214428.png (3.53 КБ)

Николай

Пользователь

Сообщений: 229
Регистрация: 01.01.1970

#26

07.10.2017 21:49:24

Опа.
Удаление строк

Код
Workbooks.Open sfName1 ActiveWorkbook.SaveAs sfName2, 56 ActiveWorkbook.Close False Kill sfName1

Решило проблему.

Николай

Пользователь

Сообщений: 229
Регистрация: 01.01.1970

#27

08.10.2017 09:51:08

Вот как стал выглядеть код в итоге.

Код

Sub Микро_на_сдачу()
    Dim sFolder As String, sFiles As String
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    With UserForm1
        .Show 0
        .Label1.Caption = "Работаем..."
        .Repaint
        For i = 1 To 100000000
        Next
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*№*.xlsm")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        'действия с файлом         
        Sheets("Приложение № 7 ").Select
        ActiveSheet.Unprotect 'снимаем блокировку с листа
        Cells.Select 'выделяем весь лист
        Selection.Copy 'Копируем
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False ' вставляем в лист значения за место формул
        Range("A1").Select
        Sheets("Приложение № 3 ").Select
        ActiveSheet.Unprotect
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("A1").Select
        Sheets("Титульный").Select
        Range("A1").Select
        Sheets("Микроучасток").Select
        Range("Таблица1[[#Headers],[№ п.п]]").Select
        ActiveWindow.Zoom = 100
        'Преорбазуем таблицы в диапазоны
        Dim sh1 As Worksheet
        Dim iObj As ListObject
        For Each sh1 In Worksheets
        For Each iObj In sh1.ListObjects
            iObj.Unlist
        Next
        Next
        'Макрос сохранения книги со старым именем и новым расширением xlsx
        Dim sfName1$
        Dim sh As Worksheet, nm As Name
        sfName1 = ActiveWorkbook.FullName
        sfName1 = Replace(sfName1, "xlsm", "xlsx")
        Application.ScreenUpdating = False
        Application.CopyObjectsWithCells = False
        ActiveWorkbook.Sheets(Array(1, 2, 3, 5)).Copy
        'Преобразование формул в значения, не всегда работает корректно, оставил просто так.
        For Each sh In ActiveWorkbook.Worksheets
            sh.UsedRange.Value = sh.UsedRange.Value
        Next
        'Удаление именнованных диапазонов показать по ctrl+F3
         For Each n In ActiveWorkbook.Names:
        On Error Resume Next
        n.Delete:
        Next
        
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs sfName1, 51
        ActiveWorkbook.Close False
        Application.DisplayAlerts = True
        Application.CopyObjectsWithCells = True
    
        'Закрываем книгу с сохранением изменений
        ActiveWorkbook.Close False 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
    .Label1.Caption = "ГОТОВО"
    End With
End Sub

Огромная благодарность RAN, за его код сохранения файлов.

Изменено: Николай — 08.10.2017 12:38:36

LAD Пользователь Сообщений: 22 Регистрация: 20.12.2015	#28 08.10.2017 14:57:17 Не думал, что можно так сильно извратить.

Источник

1 / 1 / 1

Регистрация: 26.04.2014

Сообщений: 119

Сохранить файл без макросов

10.02.2015, 17:16. Показов 7605. Ответов 7

Есть один файл, с одним листом. Называется он oo.xls. Как его сохранить как ooo.xls без макросов, и закрыть?Windows(«oo.xls»).SaveAs ooo.xls сохраняет его с макросами.

6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

10.02.2015, 17:29

Если Эксель позволяет — сохраните как xlsx, закройте, затем можно открыть и сохранить как xls.

1 / 1 / 1

Регистрация: 26.04.2014

Сообщений: 119

10.02.2015, 17:32

[ТС]

не позволяет.

6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

10.02.2015, 18:04

Для 2003 есть патч.
А вообще — где макрос то? Может достаточно скопировать/перенести лист в новую книгу?

2670 / 786 / 176

Регистрация: 14.01.2013

Сообщений: 3,676

10.02.2015, 19:24

Если сам лист не содержит кода макросов, то создать новую книгу, скопировать туда лист и сохранить. Если лист с кодом, то данные с листа скопировать в новую книгу, с сохранением оформления.

0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 10

03.09.2019, 09:53

поправка

предыдущий пример выдает ошибку.

формат — xlOpenXMLWorkbook

Источник

For this answer, I’m assuming that by Excel macro-enabled template, you mean a xltm file. I also guess that what you mean by «new document» is the document that is generated when a user double-clicks on the xtlm file (hence this new file has no location on since it hasn’t been saved yet).

To solve your issue, you could use a custom SaveAs window (Application.GetSaveAsFilename) to have more control on how the user saves the file when the Workbook_BeforeSave event macro gets called.

Here is how to implement it:

1 — Copy this code into a new module.

Option Explicit  

Sub SaveAsCustomWindow()  

    Const C_PROC_NAME As String = "SaveAsCustomWindow"
    Dim strFullFileName As String, strPreferedFolder As String, strDefaultName As String
    Dim UserInput1 As Variant, UserInput2 As Variant
    Dim isValidName As Boolean, isFileClosed As Boolean, isWorkbookClosed As Boolean
    Dim strFilename As String, strFilePath As String


    'To avoid Warning when overwriting
    Application.DisplayAlerts = False
    'Disable events (mostly for the BeforeSave event) to avoid creating infinite loop
    Application.EnableEvents = False
    On Error GoTo ErrHandler

    'Customizable section
    strDefaultName = ThisWorkbook.Name
    strPreferedFolder = Environ("USERPROFILE")

    Do While isWorkbookClosed = False
        Do While isFileClosed = False
            Do While isValidName = False
                UserInput1 = Application.GetSaveAsFilename(InitialFileName:=strPreferedFolder & "" & strDefaultName, FileFilter:="Excel Workbook (*.xlsx),*.xlsx")

                If UserInput1 = False Then
                    GoTo ClosingStatements 'This is important to take care of the case when the user presses cancel
                Else
                    strFullFileName = UserInput1
                End If

                strFilename = Right(strFullFileName, Len(strFullFileName) - InStrRev(strFullFileName, ""))
                strDefaultName = strFilename

                strFilePath = Left(strFullFileName, InStrRev(strFullFileName, "") - 1)
                strPreferedFolder = strFilePath

                'If the file exist, ask for overwrite permission
                If Dir(strFullFileName) <> "" Then
                    UserInput2 = MsgBox(strFilename & " already exists." & vbNewLine & "Do you want to overwrite?", vbYesNoCancel Or vbExclamation)
                    If UserInput2 = vbNo Then
                        isValidName = False
                    ElseIf UserInput2 = vbYes Then
                        isValidName = True
                    ElseIf UserInput2 = vbCancel Then
                        GoTo ClosingStatements
                    Else
                        GoTo ClosingStatements
                    End If
                Else
                    isValidName = True
                End If
            Loop

            'Check if file is actually open
            If isFileOpen(strFullFileName) Then
                MsgBox "The workbook you want to overwrite is currently open. Choose a different name, or close the  workbook before saving.", vbExclamation
                isValidName = False
                isFileClosed = False
            Else
                isFileClosed = True
            End If
        Loop

        'Check if an opened workbook has the same name
        If isWorkbookOpen(strFilename) Then
            MsgBox "You cannot save this workbook with the same name as another open workbook or add-in. Choose a different name, or close the other workbook or add-in before saving.", vbExclamation
            isValidName = False
            isFileClosed = False
            isWorkbookClosed = False
        Else
            isWorkbookClosed = True
        End If
    Loop

    ThisWorkbook.SaveAs Filename:=strFullFileName, FileFormat:=xlOpenXMLWorkbook

ClosingStatements:
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Exit Sub
ErrHandler:
    Call MsgBox("Run-time error '" & Err.Number & "': " & Err.Description & vbNewLine & _
         "While running: " & C_PROC_NAME & IIf(Erl <> 0, vbNewLine & "Error Line: " & Erl, "")
    GoTo ClosingStatements

End Sub

Function isFileOpen(ByVal Filename As String) As Boolean

    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open Filename For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
        Case 0:    isFileOpen = False
        Case 70:   isFileOpen = True
    End Select

End Function

Function isWorkbookOpen(ByVal Filename As String) As Boolean

    Dim wb As Workbook, ErrNo As Long

    On Error Resume Next
    Set wb = Workbooks(Filename)
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
        Case 0:         isWorkbookOpen = True
        Case Else:      isWorkbookOpen = False
    End Select

End Function

Explanation of part 1: This whole thing might seem a bit overkill, but all the error handling is important here to take into account potential errors and make sure that the setting for Application.EnableEvents is turned back to TRUE even if an error occurs. Otherwise, all event macros will be disabled in your Excel application.

2 — Call the SaveAsCustomWindow procedure inside the Workbook_BeforeSave event procedure like this:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Your code

    If ThisWorkbook.Path = "" Then
        SaveAsCustomWindow
        Cancel = True
    End If

End Sub

Note that we need to set the variable Cancel = True in order to prevent the default SaveAs window to show up. Also, the if statement is there to make sure that the custom SaveAs window will only be used if the file has never been saved.

Источник

У нас есть лист Excel с некоторыми формулами и макросами. Мы хотим сохранить данные в виде другого листа Excel без формул и макросов, прежде чем запускать макросы на текущем листе.

Следует просто сохранить значения. Один из способов — скопировать все данные и вставить их как значения в другой лист Excel и сохранить их. Но есть ли другой простой способ сделать это?

изменён Sathyajith Bhat53k

Это двухступенчатый процесс

A. Прокрутите все листы и скопируйте ячейки, а затем введите специальные значения (не нужно копировать их на другой лист)

Sub Sample()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        ws.Cells.Copy
        ws.Cells.PasteSpecial xlPasteValues
    Next

    Application.CutCopyMode = False
End Sub

Если вы не хотите идти по VBA, вам придется вручную скопировать и выполнить PasteSpecial. Как только вышеперечисленное сделано

Б. Вы можете избавиться от макросов, сохранив файл как .xlsx . Вам придется закрыть и снова открыть файл. Таким образом, ваш оригинальный файл останется нетронутым.

ответ дан Siddharth Rout387

Перейдите в раздел «Данные» на ленте вверху Excel, нажмите на ссылку «Изменить ссылки» (в части соединений этой панели инструментов около середины, а затем разорвите ссылку для каждой увиденной ссылки.

Источник

Сохранить файл без макросов

А вот еще интересные статьи: