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

Регистрация

Напомнить пароль

= Мир MS Excel/Сохранить файл без макросов - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Сохранить файл без макросов (Макросы/Sub)

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

Дата: Вторник, 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]
Спасибо!

Прошу не кидать тапками, то, что нашел на форуме, не смог применить для своей ситуации.
Есть код, сохраняющий файл в заранее выбранную папку. Но, так как файл потихоньку обрастает кодом, размеры сохранений занимают довольно много места на диске.
Подскажите, пожалуйста, можно ли переписать код таким образом, чтобы конечный файл сохранялся в формате 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

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

Ответить

СообщениеПрошу не кидать тапками, то, что нашел на форуме, не смог применить для своей ситуации.
Есть код, сохраняющий файл в заранее выбранную папку. Но, так как файл потихоньку обрастает кодом, размеры сохранений занимают довольно много места на диске.
Подскажите, пожалуйста, можно ли переписать код таким образом, чтобы конечный файл сохранялся в формате 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:10

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

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

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

Сообщений: 2566

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

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

Excel 2010

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

Код

Application.DisplayAlerts = False 'True

[/vba]

Яндекс: 410016850021169

Ответить

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

Группа: Админы

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

Сообщений: 16734

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Цитата pips, 06.11.2018 в 16:10, в сообщении № 1 ()

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

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

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

Ответить

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

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

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

Сообщений: 69

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

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

Excel 2010

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

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

Ответить

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

Группа: Админы

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

Сообщений: 16734

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

Замечаний: ±

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

Ответить

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

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

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

Сообщений: 69

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

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

Excel 2010

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

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

Ответить

Дата: Среда, 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...

Ответить

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

Группа: Админы

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

Сообщений: 16734

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

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

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

Ответить

Дата: Среда, 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

Ответить

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

Группа: Админы

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

Сообщений: 16734

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Какое значение у переменной FileName в моменты SaveCopyAs и SaveAs
Попробуйте сохранить с прямым указанием формата
https://docs.microsoft.com/ru-ru....%3Dtrue
https://docs.microsoft.com/ru-ru/office/vba/api/excel.xlfileformat

На самом деле так довольно сложно - нет Replace_symbols, нет Range("B2"), нет UserForm1. Поэтому Вы попытайтесь там самостоятельно повертеть

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

Ответить

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

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

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

Сообщений: 69

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

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

Excel 2010

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

Ответить

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

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

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

Сообщений: 5660

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

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

2010

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]

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

Ответить

Дата: Среда, 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]

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

[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

Ответить

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

[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:17

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

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

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

Сообщений: 69

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

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

Excel 2010

Цитата RAN, 07.11.2018 в 12:15, в сообщении № 12 ()

pips'у от Пипса

Коту привет

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

Ответить

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

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

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

Сообщений: 69

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

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

Excel 2010

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

^_^

Ответить

Дата: Пятница, 29.11.2024, 11:07 | Сообщение № 16

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

Ранг: Новичок

Сообщений: 19

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

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

Имеет ли место быть такой вариант? Цель: пересохранить файл без макроса с заданным именем и с выбором нужной директории.

[vba]

Код

Sub SaveAs()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim x1 As String
    Dim x2 As Variant
        x1 = "Книга1"
        x2 = Application.GetSaveAsFilename(InitialFileName:=x1, _
        FileFilter:="Excel Files (*.xlsx), *.xlsx")
    If x2 <> False Then
        ActiveWorkbook.SaveAs x1 & ".xlsx", 51
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

[/vba]

Ответить

Сохранить файл без макросов (Макросы/Sub)

Страница 1 из 1
1

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!