Макрос копирования таблицы в новый документ

@strike383 · Регистрация: 24.07.2013

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

Здравствуйте, имеем сложную таблицу из нескольких, причем новые таблицы можно добавлять и удалять нажатием кнопки, так же в таблице, помимо макрос прописаны и формулы. Задача, прописать макрос, который при нажатии на кнопку "сохранить", будет копировать данную таблицу в новую книгу и сохранять ее на диск d:// присуждая ей имя "заказ 1, 2, 3 и т.д", (или спрашивать имя и путь куда сохранить). Причем таблица должна сохраняться без кнопок, макрос и формул, но с теми данными, суммами и картинками, которые в ней уже прописаны. И сохраняться должна со столбца A до H. Так же под таблицей имеется еще несколько данных, сумма в рублях, сумма в юанях и курс 1 юаня, (это 7 строк под ней) нужно чтоб сохранялась таблица только до 4-й строки, то-есть -3 строки снизу. Пока у меня хватило фантазии сделать кнопку, помогите с макросом пожалуйста.

@Doktor1962 · 27.07.2013, 12:59

Хотя бі распишите подробно какой хоть файл (судя по заглавиям столбцов и наличию формул - єксель, но поскольку таблиці удаляются - то вроде и ворд) А лучше пример прикрепить

@strike383 · 27.07.2013, 13:28 **[ТС]**

Извини, забыл пояснить, excel 2010

Добавлено через 4 минуты
Пример нет возможности сейчас прикрепить, но можно посмотреть в другой теме мою таблицу https://www.cyberforum.ru/atta... 1374764318

@strike383 · 28.07.2013, 02:47 **[ТС]**

Сообщение от Doktor1962

Хотя бі распишите подробно какой хоть файл (судя по заглавиям столбцов и наличию формул - єксель, но поскольку таблиці удаляются - то вроде и ворд) А лучше пример прикрепить

Таблицу прикрепил

@Alex77755 · 28.07.2013, 08:04

Пока у меня хватило фантазии сделать кнопку

Для начала могу подсказать: включи запись макроса и сделай вручную, что надо.
Останется немного дорботать

Добавлено через 12 минут
Добавь запрос имени или проверку нумерации файлов.
Сделано в 2003

Visual Basic

Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 28.07.2013 (Александр)
    Dim LR
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:G" & LR).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveSheet.Shapes("Блок-схема: ИЛИ 1").Cut
    Range("F" & LR - 1 & ":G" & LR - 1).UnMerge
    Range("F" & LR - 1 & ":G" & LR - 1).ClearContents
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:="D:\1.xls", FileFormat:=xlNormal, Password _
        :="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:= _
        False
End Sub

@strike383 · 28.07.2013, 10:28 **[ТС]**

Отлично, спасибо тебе. Я с макросами вообще не дружу, можешь поправить код чтоб при сохранении запрашивал имя файла, так же возможно сохранить ширину колонок при копировании, а то все колонки сжимаются как при стандартном виде. Так же можно сделать чтоб не сохранялись последние 3 строки под таблицей и пятая (если смотреть снизу), то есть нужно чтоб под таблицей только осталась "общая сумму в юанях"

Добавлено через 51 минуту
немного подредактировал, вообщем
1. не могу добиться чтоб колонки сохраняли свой размер, причина скорее всего в этом:

Отчет о совместимости для Заказ.xls
Дата отчета: 7/28/2013 16:01

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

Несущественная потеря точности Число экземпляров Версия

Некоторые ячейки или стили в этой книге содержат форматирование, не поддерживаемое выбранным форматом файла. Эти форматы будут преобразованы в наиболее близкий из имеющихся форматов. 20 Excel 97-2003

Можете поправить код под 2010.
2. Как заставить прописывать имя я нашел где, а вот как заставить спрашивать имя документа перед сохранением?
3. не могу прописать чтоб последние 5 строки под таблицей не сохранялись, их под таблицей 8, нужно чтоб сохранялись 3 первые

Добавлено через 1 час 19 минут
Размер столюцов в сохраненной таблице должен быть:

Visual Basic

    Columns("A:A").Select
    Selection.ColumnWidth = 12.86
    Columns("B:B").Select
    Selection.ColumnWidth = 10.86
    Columns("C:C").Select
    Selection.ColumnWidth = 14.43
    Columns("D:D").Select
    Selection.ColumnWidth = 21.71
    Columns("E:E").Select
    Selection.ColumnWidth = 41.29
    Columns("F:F").Select
    Selection.ColumnWidth = 6.86
    Columns("G:G").Select
    Selection.ColumnWidth = 10.29

как (куда) прописать его в этот код

Сообщение от Alex77755

Visual Basic

Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 28.07.2013 (Александр)
    Dim LR
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:G" & LR).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveSheet.Shapes("Блок-схема: ИЛИ 1").Cut
    Range("F" & LR - 1 & ":G" & LR - 1).UnMerge
    Range("F" & LR - 1 & ":G" & LR - 1).ClearContents
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:="D:\1.xls", FileFormat:=xlNormal, Password _
        :="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:= _
        False
End Sub

@Alex77755 · 28.07.2013, 12:05

Сейчас сделаю в 2010....

@strike383 · 28.07.2013, 16:44 **[ТС]**

Сообщение от Alex77755

Сейчас сделаю в 2010....

Получается?

@Alex77755 · 28.07.2013, 18:26

Да !

@strike383 · 28.07.2013, 18:33 **[ТС]**

покажешь? ))

@Alex77755 · 28.07.2013, 18:42

Ну, примерно, так:

Visual Basic

Sub Ну_Вот()
' Макрос1 Макрос
' Макрос записан 28.07.2013 (Александр)
    Dim LR, C
    Dim LC(1 To 8)
    For C = 1 To 8 ' запоминаем ширину
    LC(C) = Columns(C).ColumnWidth
    Next C
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:G" & LR).Copy
    Workbooks.Add
    ActiveSheet.Paste
    For C = 1 To 8   ' делаем ширину
    Columns(C).ColumnWidth = LC(C)
    Next C
    ActiveSheet.Shapes("Блок-схема: ИЛИ 1").Cut
    Range("F" & LR - 1 & ":G" & LR - 1).UnMerge
    Range("F" & LR - 1 & ":G" & LR - 1).ClearContents
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
     Dim FLE
    FLE = Application.GetSaveAsFilename()
    If FLE = "False" Then
        ActiveWorkbook.Close SaveChanges:=False
        Exit Sub
    Else:
ActiveWorkbook.SaveAs Filename:=FLE, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    End If   
End Sub

@strike383 · 28.07.2013, 19:09 **[ТС]**

Работает, путь и имя спрашивает, ошибки нет, а вот ширина столбцов все равно не запоминается, ставится по умолчанию 8,43, и нужно чтоб последние 3 строки удалялись

Добавлено через 1 минуту
и расширение надо вручную в имени прописывать, не ставит автоматом

@Alex77755 · 28.07.2013, 20:23

нужно чтоб последние 3 строки удалялись

поставь

Visual Basic

1	LR = Cells(Rows.Count, 1).End(xlUp).Row-3

и радуйся

@strike383 · 29.07.2013, 11:25 **[ТС]**

Сообщение от Alex77755

поставь

Visual Basic

1	LR = Cells(Rows.Count, 1).End(xlUp).Row-3

и радуйся

Спасибо, а как быть шириной столбцов и расширением файла?

Добавлено через 13 часов 18 минут
с расширение разобрался, прописал

Visual Basic

1 2	FLE = Application.GetSaveAsFilename("заказ.xlsx", "Книга Excel (*.xlsx),", , _ "Введите имя файла для сохраняемого заказа", "Сохранить")

а вот ширина столбцов всеравно не сохраняется, подскажите как прописать ее?

@strike383 · 30.07.2013, 10:25 **[ТС]**

Alex77755 вот скрин и таблица

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
		1
	Макрос копирования таблицы в новый документ 27.07.2013, 06:03. Показов 9653. Ответов 14 Метки нет (Все метки) Здравствуйте, имеем сложную таблицу из нескольких, причем новые таблицы можно добавлять и удалять нажатием кнопки, так же в таблице, помимо макрос прописаны и формулы. Задача, прописать макрос, который при нажатии на кнопку "сохранить", будет копировать данную таблицу в новую книгу и сохранять ее на диск d:// присуждая ей имя "заказ 1, 2, 3 и т.д", (или спрашивать имя и путь куда сохранить). Причем таблица должна сохраняться без кнопок, макрос и формул, но с теми данными, суммами и картинками, которые в ней уже прописаны. И сохраняться должна со столбца A до H. Так же под таблицей имеется еще несколько данных, сумма в рублях, сумма в юанях и курс 1 юаня, (это 7 строк под ней) нужно чтоб сохранялась таблица только до 4-й строки, то-есть -3 строки снизу. Пока у меня хватило фантазии сделать кнопку, помогите с макросом пожалуйста. 0

@Doktor1962 6 / 23 / 2 Регистрация: 29.01.2013 Сообщений: 174
	27.07.2013, 12:59	2
	Хотя бі распишите подробно какой хоть файл (судя по заглавиям столбцов и наличию формул - єксель, но поскольку таблиці удаляются - то вроде и ворд) А лучше пример прикрепить 0

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	27.07.2013, 13:28 [ТС]	3
	Извини, забыл пояснить, excel 2010 Добавлено через 4 минуты Пример нет возможности сейчас прикрепить, но можно посмотреть в другой теме мою таблицу https://www.cyberforum.ru/atta... 1374764318 0

@Alex77755 11508 / 3794 / 681 Регистрация: 13.02.2009 Сообщений: 11,197
	28.07.2013, 12:05	7
	Сейчас сделаю в 2010.... 1

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	28.07.2013, 16:44 [ТС]	8
	Сообщение от Alex77755 Сейчас сделаю в 2010.... Получается? 0

@Alex77755 11508 / 3794 / 681 Регистрация: 13.02.2009 Сообщений: 11,197
	28.07.2013, 18:26	9
	Да ! 1

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	28.07.2013, 18:33 [ТС]	10
	покажешь? )) 0

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	28.07.2013, 19:09 [ТС]	12
	Работает, путь и имя спрашивает, ошибки нет, а вот ширина столбцов все равно не запоминается, ставится по умолчанию 8,43, и нужно чтоб последние 3 строки удалялись Добавлено через 1 минуту и расширение надо вручную в имени прописывать, не ставит автоматом 0