Страницы: 1
RSS
VBA из основного листа сохранить в новую книгу с данными без формул, без макросов и без VBA
 
Всем привет
Прошу помочь
В общем столкнулся с потребность сделать рабочий файл XLS для формирования отчетов
нужно сохранять по типу "Название" + "Дата ГГГГ.ММ.ДД" но без VBA и макросов,
решил сделать тупое копирования таблицы средствами формул и не знаю что дальше делать...
да и сохраняет с VBA и макросами
Код
Sub СохранитьЛистВФайл()
    On Error Resume Next
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
    Const REPORTS_FOLDER = "\"
    ' создаём папку для файла, если её ещё нет
    MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    ' выбираем стартовую папку
    ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
 
    ' вывод диалогового окна для запроса имени сохраняемого файла
    Filename = "Проверка КВ-" + Format(Date, "yyyy/mm/dd") + ".xls"
        ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
    If VarType(Filename) = vbBoolean Then Exit Sub
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа

    ' убеждаемся, что активной книгой является копия листа
    If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
        ' сохраняем файл под заданным именем в формате Excel 2003
        ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
 
        ' закрываем сохранённый файл
        ' (удалите следующую строку, если закрывать созданный файл не требуется)
        ActiveWorkbook.Close False
    End If
End Sub
Изменено: WaleryN - 10.12.2019 10:23:51
 
А просто в xlsX сохранить нельзя? Это самый простой способ.
Я не волшебник, я только учусь.
 
У Вас проблема в строчке
Код
Err.Clear: ActiveSheet.Copy: DoEvents
Вы копируете лист, а это происходит уже вместе с формулами. У меня есть вот такое вот решение, вроде бы работает. Жалоб не было. Нету строчки с сохранением + у листа в новой книги стандартное название.
Код
Private Sub CommandButton1_Click()
    Dim rngX As Range
    Dim wbX As Workbook
    Dim shX As Worksheet
    Dim val
    Dim zoo
    
    Application.EnableEvents = False
    
    zoo = ActiveWindow.Zoom
    
    Set rngX = ActiveSheet.UsedRange
    Set wbX = Workbooks.Add
    Set shX = wbX.ActiveSheet
    
    ActiveWindow.Zoom = zoo
    
    val = rngX.Value
    
    On Error Resume Next
    ThisWorkbook.ActiveSheet.ShowAllData
    On Error GoTo 0
    rngX.Copy
    
    shX.Paste
    shX.PasteSpecial xlPasteColumnWidths
    shX.Range(rngX.Address) = val
    Application.CutCopyMode = xlCopy
    
    wbX.Saved = True
    Application.EnableEvents = True
End Sub
Я не волшебник, я только учусь.
 
Куда копирует книгу так и не понял.
Кнопки тоже копируются в новую книгу
и макросы скорее всего тоже
ну и название не создается как нужно

ПС
можно и в xlsx
Изменено: WaleryN - 10.12.2019 11:31:04
 
Банить меня нужно за такую "помощь". Мозг запудрил, а не помог. Мой макрос копирует данные с листа в новую книгу, но не сохраняет. В теории там не хватает 2-х строчек:
1. Задать нужное имя листу. ( что-то типа activeSheeet.name = thisWorkbook.activeSheet.name)
2. Сохранить (это у Вас есть).

В Вашем макросе нужно заменить в строке с SaveAs  xlWorkbookNormal на  xlWorkbookDefault и книга сохранится как xlsx. При её переоткрытии макросы пропадут.
По части кнопок посмотрите тут: https://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=1&TID=49791. Если на листе нету нужных картинок и ещё каких-нить фигур, то можно просто:
Код
Dim IShape as Sape
For Each IShape In ActiveSheet.Shapes    
      IShape.Delete
Next
Я не волшебник, я только учусь.
 
Цитата
WaleryN написал:
VBA из основного листа сохранить ..., без макросов и без VBA
"VBA без макросов и VBA", это что-то новое, интересно будет посмотреть на решение
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Игорь, это я не правильно описал проблему
правильно наверное удалить макросы в сохраненной книге
 
Wiss!!! СПАСИБО!!!
помогла подсказка с заменой xlWorkbookNormal на  xlWorkbookDefault
я бы эту тонкость не обнаружил...

Wiss, еще хочу спросить, а можно в моем коде исправить, что бы он сохранял не активную страницу, а допустим лист2 (TABL)?
при условии что бы формулы не сохранялись, а только данные.

Сейчас думаю как не сохранять ту часть таблицы где нет данных
Изменено: WaleryN - 10.12.2019 13:26:29
 
Код
Sub мяу()
    Dim awb As Workbook, sh As Worksheet, sFilename$
    Application.DisplayAlerts = False
    Application.CopyObjectsWithCells = False
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If awb Is Nothing Then
            sh.Copy
            Set awb = ActiveWorkbook
        Else
            sh.Copy After:=awb.Sheets(awb.Sheets.Count)
        End If
    Next
    sFilename = ThisWorkbook.FullName
    Mid(sFilename, Len(sFilename), 1) = "x"
    awb.SaveAs sFilename, xlOpenXMLWorkbook
    awb.Close False
    Application.DisplayAlerts = True
    Application.CopyObjectsWithCells = True
    Application.ScreenUpdating = True
End Sub
 
Цитата
Application.CopyObjectsWithCells = False
Всё гениальное просто. Спасибо. Запомню. Месяц назад с такой же проблемой бился. Такого решения не видел.
Все предлагают:
1. Либо создавать новый лист и копировать ячейки + форматы.
2. Либо копировать лист и удалять кнопки и прочие объекты.
Я не волшебник, я только учусь.
 
RAN,
Цитата
Wiss: Всё гениальное просто
поддерживаю и благодарю  :idea:

P.S.: старая тема с этим способом (от RAN)
Название темы: Сохранить в новую книгу без формул и макросов
Изменено: Jack Famous - 10.12.2019 16:15:00
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
RAN подскажите пожалуйста что за что отвечает в твоем коде (пару строк)
точнее где задать имя по типу "название"+"текущая дата ГГГГ.ММ.ДД"
Изменено: WaleryN - 10.12.2019 21:10:09 (по справедливому замечанию)
 
WaleryN, на этом форуме с незнакомыми общаются на "Вы"
 
Цитата
RAN написал:
Mid(sFilename, Len(sFilename), 1) = "x"
Ну сколько можно делать всякие дикие вещи, которые кардинально меняют мой взгляд на то, как работает VBA?!
Где конец этому безумию?!

Вот цитата из справки мелкософта:
Цитата
Returns a Variant (String) containing a specified number of characters from a string.
Mid возвращает строку, а не ссылку. Код Mid(sFilename, Len(sFilename), 1) = "x" не должен работать (но само-собой работает).
Изменено: Wiss - 11.12.2019 10:05:17
Я не волшебник, я только учусь.
 
Цитата
Wiss: Код Mid(sFilename, Len(sFilename), 1) = "x"  не должен работать
я увидел подобное (Mid$(s, i + 1) = v) впервые у ZVI. nerv там тоже удивился))
Изменено: Jack Famous - 11.12.2019 10:15:36
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Mid Function
Returns a Variant (String) containing a specified number of characters from a string.

Цитата
Mid Statement
Replaces a specified number of characters in a Variant (String) variable with characters from another string.

Читать нужно в нужном месте.  :D

http://vb-ideas.narod.ru/articles/vb_001-1.html
https://www.koscheev.ru/education/?file=27
Изменено: RAN - 11.12.2019 11:41:36
 
RAN, крутые ссылки — спасибо  :idea:
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
RAN написал:
Mid Function
.....
Mid Statement
Ну спасибо, блин. Теперь оказывается, что в      X=mid(...) и mid(...) =x        за сочетанием букв "mid" понимаются вообще разные сущности. И как мне теперь с этим жить?!

P.S. В смысле реально спасибо и за науку и за ссылки. Схоронил.
Изменено: Wiss - 12.12.2019 14:20:54
Я не волшебник, я только учусь.
 
Добрый день
Долго не мог написать из-за работы...
В общем я снова экспериментирую с кодом...
где-то вляпал ошибку
Код
Sub мяу()
    Dim awb As Workbook, sh As Worksheet, sFilename$
    Application.DisplayAlerts = False
    Application.CopyObjectsWithCells = False
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If awb Is Nothing Then
            sh.Copy
            Set awb = ActiveWorkbook
        Else
            sh.Copy After:=awb.Sheets(awb.Sheets.Count)
        End If
    Next
    sFilename = ThisWorkbook.FullName + "-" + Format(Date, "yyyy/mm/dd") + ".xlsx"
    Mid(sFilename, Len(sFilename), 1) = "x"
    awb.SaveAs sFilename, xlOpenXMLWorkbook
    awb.Close False
    Application.DisplayAlerts = True
    Application.CopyObjectsWithCells = True
    Application.ScreenUpdating = True
End Sub

и сейчас пишет имя созданного файла Отчет.xlsx-2019.12.18.xlsx
в строке FullName менял на Name ... совсем не помогло
в общем в имя файла нужно корректно в конце вставить дату
Прошу помощи,
Заранее благодарю!
Изменено: WaleryN - 18.12.2019 13:39:09
 
Игра "угадай, где нужная строка"? :)
Отредактируйте код. Не нужно под спройлер каждую строку. Оформление кода - кнопка <...>
 
заигрался с редактированием, прошу простить :(

строка    
Код
sFilename = ThisWorkbook.FullName + "-" + Format(Date, "yyyy/mm/dd") + ".xlsx"

14 строка
Расширение старое перед датой пишет
Изменено: WaleryN - 18.12.2019 13:44:31
 
Код
 sFilename = Replace(ThisWorkbook.FullName,"Отчет","Отчет-" & Format(Date, "yyyy/mm/dd"))
 
Дату перестало писать...

с этой формулой пишет Имяфайла.xlsx
Код
sFilename = Replace(ThisWorkbook.FullName,"Отчет","Отчет-" & Format(Date, "yyyy/mm/dd"))


а с этой Имяфайла.xlsm-2019.12.18.xlsx
Код
sFilename = ThisWorkbook.FullName + "-" + Format(Date, "yyyy/mm/dd") + ".xlsx"
Изменено: WaleryN - 18.12.2019 13:58:14
 
Цитата
WaleryN написал: с этой формулой пишет Имяфайла.xlsx
В имени нет слова Отчет, как Вы раньше показали.
 
СПАСИБО!!!
Это я на создавал папок и файлов и уже туплю.
Еше раз Благодарю!!!
Страницы: 1
Наверх