Макрос сохранить как excel без макросов

 

PATRI0T

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

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

#1

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

#3

06.10.2017 08:17:17

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

А зачем это?

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

Александр П.

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

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

#4

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

#5

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

#9

07.10.2017 00:34:38

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

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

 

LAD

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

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

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

Изменено: LAD07.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

Изменено: RAN07.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
  ……………………………

Изменено: RAN07.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

1

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

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


Студворк — интернет-сервис помощи студентам

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



0



6875 / 2807 / 533

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

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

10.02.2015, 17:29

2

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



0



1 / 1 / 1

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

Сообщений: 119

10.02.2015, 17:32

 [ТС]

3

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



0



6875 / 2807 / 533

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

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

10.02.2015, 18:04

4

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



0



Эксперт NIX

2670 / 786 / 176

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

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

10.02.2015, 19:24

5

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



0



0 / 0 / 0

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

Сообщений: 10

03.09.2019, 09:53

8

поправка

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

формат — xlOpenXMLWorkbook



0



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

pips

Дата: Вторник, 06.11.2018, 16:10 |
Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 69


Репутация:

0

±

Замечаний:
0% ±


Excel 2010

Прошу не кидать тапками, то, что нашел на форуме, не смог применить для своей ситуации.
Есть код, сохраняющий файл в заранее выбранную папку. Но, так как файл потихоньку обрастает кодом, размеры сохранений занимают довольно много места на диске.
Подскажите, пожалуйста, можно ли переписать код таким образом, чтобы конечный файл сохранялся в формате Excel без макросов? (.xls или .xlsx)

[vba]

Код

Private Sub CommandButton18_Click() ‘сохранение в нужную папку
    Dim FileName$, NewDir$
    ‘создание папки в текущей папке и сохранение туда файла
    ‘NewDir = ThisWorkbook.Path & «» & Replace_symbols(UserForm1.TextBox8.Text) & Replace_symbols(UserForm1.ComboBox1.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text)
    ‘создание папки в нужной директории
    NewDir = Worksheets(«Service»).Range(«B2») & «» & Replace_symbols(UserForm1.TextBox8.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text)
    If Dir(NewDir, vbDirectory) = «» Then
    MkDir (NewDir)
    FileName = NewDir & «» & Replace_symbols(UserForm1.TextBox8.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text) & «.xlsm»
    ActiveWorkbook.SaveCopyAs FileName
    MsgBox «Файл сохранен в папке Отчеты»
    Else
    SavePath = SaveFolder(NewDir)
    FileName = Replace_symbols(UserForm1.TextBox8.Text) & Replace_symbols(UserForm1.ComboBox1.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text) & «.xlsm»
    ActiveWorkbook.SaveCopyAs SavePath & «» & FileName
    MsgBox «Такая папка уже существует. Копия сохранена в папке Отчеты»
    End If
End Sub

[/vba]
Спасибо!

Сообщение отредактировал pipsВторник, 06.11.2018, 16:11

 

Ответить

sboy

Дата: Вторник, 06.11.2018, 16:14 |
Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566


Репутация:

724

±

Замечаний:
0% ±


Excel 2010

Поменяйте расширение в коде с .xslm на .xlsx и не забудьте отключить оповещения в начале кода и включить в конце
[vba]

Код

Application.DisplayAlerts = False ‘True

[/vba]


Яндекс: 410016850021169

 

Ответить

_Boroda_

Дата: Вторник, 06.11.2018, 16:16 |
Сообщение № 3

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16618


Репутация:

6465

±

Замечаний:
0% ±


2003; 2007; 2010; 2013 RUS

чтобы конечный файл сохранялся в формате Excel без макросов? (.xls или .xlsx)

А какая разница? На размер повлияет только в большую сторону (если xls). Меньше будет, если сохранять в xlsb
Не пробовали заменить xlsm на xlsx в коде?


Скажи мне, кудесник, любимец ба’гов…
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

 

Ответить

pips

Дата: Вторник, 06.11.2018, 16:19 |
Сообщение № 4

Группа: Пользователи

Ранг: Участник

Сообщений: 69


Репутация:

0

±

Замечаний:
0% ±


Excel 2010

Я, возможно, как то не так объяснил. Я менял расширение при сохранении на .xls, при открытии готового файла было предупреждение, что расширение файла не соотвтетствует его формату, и все макросы и UserForm были в файле сохранены. После предупреждения файл открылся.
При замене на .xlsx появляется ошибка, но файл открыть не возможно.

Сообщение отредактировал pipsВторник, 06.11.2018, 16:29

 

Ответить

_Boroda_

Дата: Вторник, 06.11.2018, 16:33 |
Сообщение № 5

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16618


Репутация:

6465

±

Замечаний:
0% ±


2003; 2007; 2010; 2013 RUS

У Вас получается, что Вы хотите сохранить КОПИЮ, которая копийе не является — расширения-то разные. Тогда сначала сохраняйте в xlsm, потом открывайте копию и пересохраняйте в нужном формате. Все это, конечно же, макросом

Примерно вот так
[vba]

Код

With Workbooks.Open(NewDir & «» & FileName)
      .SaveAs Replace(NewDir & «» & FileName, «.xlsm», «.xlsb»)
      .Close 0
End With
Kill NewDir & «» & FileName

[/vba]


Скажи мне, кудесник, любимец ба’гов…
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

 

Ответить

pips

Дата: Вторник, 06.11.2018, 16:35 |
Сообщение № 6

Группа: Пользователи

Ранг: Участник

Сообщений: 69


Репутация:

0

±

Замечаний:
0% ±


Excel 2010

Понял, большое спасибо за код.

Сообщение отредактировал pipsВторник, 06.11.2018, 16:40

 

Ответить

pips

Дата: Среда, 07.11.2018, 09:54 |
Сообщение № 7

Группа: Пользователи

Ранг: Участник

Сообщений: 69


Репутация:

0

±

Замечаний:
0% ±


Excel 2010

В код добавил эти строчки

[vba]

Код

    ActiveWorkbook.SaveCopyAs FileName
        With Workbooks.Open(FileName)
        .SaveAs Replace(FileName, «.xlsm», «.xlsb»)
        .Close 0
        End With
    Kill FileName

[/vba]

В таком виде он не работает, ошибка в строке .SaveAs…….
При замене .xlsb на .xls файл сохраняется, но при открытии все равно выскакивает сообщение «Файл Name.xls не соответствует разрешению файла. Возможно, файл поврежден или небезопасен»
В итоге открывается файл с сохранением кода VBA…

 

Ответить

_Boroda_

Дата: Среда, 07.11.2018, 10:00 |
Сообщение № 8

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16618


Репутация:

6465

±

Замечаний:
0% ±


2003; 2007; 2010; 2013 RUS

Весь код покажите


Скажи мне, кудесник, любимец ба’гов…
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

 

Ответить

pips

Дата: Среда, 07.11.2018, 10:02 |
Сообщение № 9

Группа: Пользователи

Ранг: Участник

Сообщений: 69


Репутация:

0

±

Замечаний:
0% ±


Excel 2010

[vba]

Код

Private Sub CommandButton18_Click() ‘сохранение в нужную папку
    Dim FileName$, NewDir$
    ‘создание папки в текущей папке и сохранение туда файла
    ‘NewDir = ThisWorkbook.Path & «» & Replace_symbols(UserForm1.TextBox8.Text) & Replace_symbols(UserForm1.ComboBox1.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text)
    ‘создание папки в нужной директории
    NewDir = Worksheets(«Service»).Range(«B2») & «» & Replace_symbols(UserForm1.TextBox8.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text)
    If Dir(NewDir, vbDirectory) = «» Then
    MkDir (NewDir)
    FileName = NewDir & «» & Replace_symbols(UserForm1.TextBox8.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text) & «.xlsm»
    ActiveWorkbook.SaveCopyAs FileName
    With Workbooks.Open(FileName)
        .SaveAs Replace(FileName, «.xlsm», «.xlsb»)
        .Close 0
        End With
    Kill FileName
    MsgBox «Файл сохранен в папке Отчеты»
    Else
    SavePath = SaveFolder(NewDir)
    FileName = Replace_symbols(UserForm1.TextBox8.Text) & Replace_symbols(UserForm1.ComboBox1.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text) & «.xlsm»
    ActiveWorkbook.SaveCopyAs SavePath & «» & FileName
    MsgBox «Такая папка уже существует. Копия сохранена в папке Отчеты»
    End If

    End Sub

[/vba]

Сообщение отредактировал pipsСреда, 07.11.2018, 10:03

 

Ответить

_Boroda_

Дата: Среда, 07.11.2018, 10:24 |
Сообщение № 10

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16618


Репутация:

6465

±

Замечаний:
0% ±


2003; 2007; 2010; 2013 RUS


Скажи мне, кудесник, любимец ба’гов…
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

 

Ответить

pips

Дата: Среда, 07.11.2018, 10:25 |
Сообщение № 11

Группа: Пользователи

Ранг: Участник

Сообщений: 69


Репутация:

0

±

Замечаний:
0% ±


Excel 2010

Хорошо, спасибо. Когда что то получится, отпишусь.

 

Ответить

RAN

Дата: Среда, 07.11.2018, 12:15 |
Сообщение № 12

Группа: Друзья

Ранг: Экселист

Сообщений: 5645

pips‘у от Пипса
[vba]

Код

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim thisName As String
    thisName = ThisWorkbook.FullName
    ThisWorkbook.Save
    ThisWorkbook.SaveAs sSavePath & «ВВОД_» & sSaveBaseName & «.xlsx», 51
    Workbooks.Open thisName
    ThisWorkbook.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

[/vba]


Быть или не быть, вот в чем загвоздка!

 

Ответить

pips

Дата: Среда, 07.11.2018, 12:17 |
Сообщение № 13

Группа: Пользователи

Ранг: Участник

Сообщений: 69


Репутация:

0

±

Замечаний:
0% ±


Excel 2010

большое спасибо за помощь, вот что в итоге получилось. Приведу полный код.

[vba]

Код

Private Sub CommandButton18_Click() ‘сохранение в нужную папку
    Dim FileName$, NewDir$
    ‘создание папки в текущей папке и сохранение туда файла
    ‘NewDir = ThisWorkbook.Path & «» & Replace_symbols(UserForm1.TextBox8.Text) & Replace_symbols(UserForm1.ComboBox1.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text)
    ‘создание папки в нужной директории
    NewDir = Worksheets(«Service»).Range(«B2») & «» & Replace_symbols(UserForm1.TextBox8.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text)
    If Dir(NewDir, vbDirectory) = «» Then
    MkDir (NewDir)
    FileName = NewDir & «» & Replace_symbols(UserForm1.TextBox8.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text) ‘1) убрал отсюда расширение
    ActiveWorkbook.SaveCopyAs FileName & «.xlsm»   ‘2)вставил его сюда
    Application.DisplayAlerts = False   ‘3) это чтобы не спрашивал, сохранять ли в формате без макросов
    With Workbooks.Open(FileName)
        .SaveAs FileName, xlWorkbookDefault   ‘4) заменил на XlFileFormat
        .Close 0
        End With
    Application.DisplayAlerts = True
    Kill FileName & «.xlsm»                 ‘5) профит
    MsgBox «Файл сохранен в папке Отчеты»
    Else
    SavePath = SaveFolder(NewDir)
    FileName = Replace_symbols(UserForm1.TextBox8.Text) & Replace_symbols(UserForm1.ComboBox1.Text) & «_» & Replace_symbols(UserForm1.TextBox4.Text)
    ActiveWorkbook.SaveCopyAs SavePath & «» & FileName & «.xlsm»
        Application.DisplayAlerts = False
    With Workbooks.Open(SavePath & «» & FileName & «.xlsm»)
        .SaveAs SavePath & «» & FileName, xlWorkbookDefault
        .Close 0
        End With
        Application.DisplayAlerts = True
    Kill SavePath & «» & FileName & «.xlsm»
    MsgBox «Такая папка уже существует. Копия сохранена в папке Отчеты»
    End If

End Sub

[/vba]

 

Ответить

pips

Дата: Среда, 07.11.2018, 12:18 |
Сообщение № 14

Группа: Пользователи

Ранг: Участник

Сообщений: 69


Репутация:

0

±

Замечаний:
0% ±


Excel 2010

Коту привет :D Спасибо, потестирую)

 

Ответить

pips

Дата: Среда, 07.11.2018, 12:45 |
Сообщение № 15

Группа: Пользователи

Ранг: Участник

Сообщений: 69


Репутация:

0

±

Замечаний:
0% ±


Excel 2010

RAN, спасибо, так намного проще ^_^

 

Ответить

Создать макрос в Excel можно, запустив средство записи макросов или с помощью редактора Visual Basic для приложений (VBA). После создания макроса следует сохранить его для возможности повторного использования в текущей или в других книгах.

Сохранение макроса в текущей книге

Если понадобится использовать макрос только в той книге, где он был создан, нажмите кнопку Сохранить или Сохранить как так же, как при обычном сохранении. Но сохранение книги с макросами происходит несколько иначе, поскольку необходимо использовать специальный формат файла «с поддержкой макросов». Поэтому при попытке сохранить макрос Excel предложит два варианта:

Книга с макросами или кодом VBA

  • Сохранить в виде книги с поддержкой макросов (XLSM-файл), выбрав Нет.

  • Сохранить в виде книги без поддержки макросов, выбрав Да.

Чтобы сохранить макрос как книгу с поддержкой макросов,

  1. щелкните Нет.

  2. В окне Сохранить как в раскрывающемся списке Тип файла выберите Книга Excel с поддержкой макросов.
    Сохранить как книгу с поддержкой макросов

  3. Нажмите кнопку Сохранить.

Создание и сохранение макросов в личной книге

Чтобы макросы были доступны при каждом запуске Excel, создайте их в книге «Personal.xlsb». Это скрытая книга на вашем компьютере, которая открывается при каждом запуске Excel. Для получения сведений о выполнении этих действий см. статью Создание и сохранение всех макросов в одной книге.

Нужна дополнительная помощь?

У нас есть лист 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, нажмите на ссылку «Изменить ссылки» (в части соединений этой панели инструментов около середины, а затем разорвите ссылку для каждой увиденной ссылки.

Понравилась статья? Поделить с друзьями:
  • Макрос сохранения файла excel в файл
  • Макрос сохранение файла excel по времени
  • Макрос создающий папку excel
  • Макрос создать таблицу в word
  • Макрос создать столбец в excel