Vba 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 нужно сохранять

Юрий М

Модератор

Сообщений: 60575
Регистрация: 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» его находит и выполняет свою задачу?

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

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

Юрий М Модератор Сообщений: 60575 Регистрация: 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

Юрий М Модератор Сообщений: 60575 Регистрация: 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 Не думал, что можно так сильно извратить.

Источник

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

pips

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

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

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

Сообщений: 69

Репутация:
0
±

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

Excel 2010

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

[vba]

Код

[/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]

Ответить

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

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

Ответить

pips

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

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

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

Сообщений: 69

Репутация:
0
±

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

Excel 2010

[vba]

Код

End Sub

[/vba]

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

Ответить

_Boroda_

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

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

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

Сообщений: 16618

Репутация:
6465
±

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

2003; 2007; 2010; 2013 RUS

Ответить

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

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

Ответить

pips

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

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

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

Сообщений: 69

Репутация:
0
±

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

Excel 2010

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

Ответить

Источник

I have created an Excel-Document with macros that my customer should fill out save pressing a button.

Under the button is just this macro:

Sub filesave()
    Dim bFileSaveAs As Boolean
    bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
End Sub

The problem is that as default option you get to save the document as macro enabled excel workbook.

How can do show as default non macro enabled excel format or not show the posibility to save the document as macro enabled document in oder to make sure that the macros will not be saved in the filled out copy of the document?

Some ideas about how the code should look like?

Pᴇʜ

56k9 gold badges49 silver badges73 bronze badges

asked Aug 13, 2018 at 12:19

You can use GetSaveAsFilename to let the user choose a location and filename and then save with Workbook.SaveAs Method by choosing a file format from XlFileFormat Enumeration.

Public Sub SaveFileAs()
    Dim FileToSave As Variant
    FileToSave = Application.GetSaveAsFilename(fileFilter:="xlsx Files (*.xlsx), *.xlsx")

    If FileToSave <> False Then
        ActiveWorkbook.SaveAs Filename:=FileToSave, FileFormat:=xlOpenXMLWorkbook
    Else
        'user chose cancel
    End If
End Sub

answered Aug 13, 2018 at 12:28

PᴇʜPᴇʜ

56k9 gold badges49 silver badges73 bronze badges

Источник

Сохранение файла рабочей книги Excel, существующего или нового, с помощью кода VBA. Методы Save и SaveAs объекта Workbook, параметр SaveChanges метода Close.

Сохранение существующего файла

Сохранить существующий открытый файл рабочей книги Excel из кода VBA можно несколькими способами. В примерах используется выражение ActiveWorkbook, которое может быть заменено на ThisWorkbook, Workbooks(«ИмяКниги.xlsx»), Workbooks(myFile.Name), где myFile — объектная переменная с присвоенной ссылкой на рабочую книгу Excel.

Простое сохранение файла после внесенных кодом VBA Excel изменений:

Сохранение файла под другим именем (исходная рабочая книга будет автоматически закрыта без сохранения внесенных изменений):

ActiveWorkbook.SaveAs Filename:=«C:ТестоваяНоваяКнига.xlsx»

Сохранить файл рабочей книги можно перед закрытием, используя параметр SaveChanges метода Close со значением True:

ActiveWorkbook.Close SaveChanges:=True

Чтобы закрыть файл без сохранения, используйте параметр SaveChanges метода Close со значением False:

ActiveWorkbook.Close SaveChanges:=False

Сохранение файла под другим именем при закрытии рабочей книги:

ActiveWorkbook.Close SaveChanges:=True, Filename:=«C:ТестоваяНоваяКнига.xlsx»

Если в примерах с методом Close параметр SaveChanges пропустить, будет открыто диалоговое окно с запросом о сохранении файла.

Новая книга сохраняется с указанием полного имени:

Workbooks.Add

ActiveWorkbook.SaveAs Filename:=«C:ТестоваяНоваяКнига.xlsx»

После этого к новой книге можно обращаться по имени: Workbooks ("НоваяКнига.xlsx").

Если не указать полное имя для сохраняемого файла:

Workbooks.Add

ActiveWorkbook.Save

тогда новая книга будет сохранена с именем и в папке по умолчанию, например: Книга1.xlsx, Книга2.xlsx, Книга3.xlsx и т.д. в папке «Документы».

Источник

Сообщение от Апострофф

Неудачное представление имени (если файлов достаточно много, то сортировка в проводнике по именам приводит к такой каше, что в глазах рябит)
Гораздо практичнее ~ такое

Спасибо, но такая форма не годится — файлов уже столько, что лучше их раскидывать по папкам.

101 Спасибо. работает но немного не так + один вопрос — Можно ли создавать в основной папке новые папки, примерно как в коде внизу.

Visual Basic

strDate = Format(Now, "mm-yy")
    sFolder = "C:UsersReportsBackup НоваяПапкаИмя & strDate"
    Err.Clear
    ChDir sFolder
        
    If Err Then MkDir "C:UsersReportsbackup НоваяПапкаИмя & strDate"

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

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

Весь код на данный момент.

Visual Basic

Sub Autoopen123()
    Dim x As String
    Dim sFolder As String
    Dim strPath As String
            
        
    On Error Resume Next
    strDate = Format(Now, "mm-yy")
    sFolder = "C:UsersReportsBackup НоваяПапкаИмя & strDate"
    Err.Clear
    ChDir sFolder
        
    If Err Then MkDir "C:UsersReportsbackup НоваяПапкаИмя & strDate"
    
    strPath = sFolder  
    On Error Resume Next
    
x = GetAttr(strPath) And 0
    
    If Err = 0 Then 
        strDate = Format(Now, "dd-mm-yy hh-mm")
        FileNameXls = strPath & "" & "ИмяФайла.xls" & " " & strDate & ".xls"  
        ActiveWorkbook.SaveAs Filename:=FileNameXls, FileFormat:=xlNormal, Password:="123", WriteResPassword:="123", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    
    Else 
        MsgBox " " & strPath & " ", vbCritical
    End If
 
End Sub

Источник