Макрос копирования таблиц нажатием кнопки

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

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

Здравствуйте, нужна помощь. Есть таблица с формулами (см. Снимок). Нужно чтоб при нажатии на кнопку (слева от таблице), создавалась такая же таблица с теми же формулами ниже (или выше) имеющейся, причем текстовые поля выделенные жирным должны сохраниться, остальные ячейки пустые. Кнопку я создал, не могу написать макрос, в результате нажатия на кнопку, должно получиться следующее (см. Снимок 2). Причем если несколько раз нажимать на кнопку, нужно чтоб таблица добавлялась на каждое нажатие. У меня excel 2010, если это важно.

@Step_UA · 24.07.2013, 09:37

Можно так ...

@strike383 · 24.07.2013, 11:02 **[ТС]**

а можешь написать относительно моей таблицы? А то я с макросами не дружу ((

@strike383 · 24.07.2013, 12:39 **[ТС]**

Step UA, тупанул немного я, спасибо, почти то что надо, есть небольшая проблемка, новая таблица добавляется не под первой, а делает отступ в 3 строки,из за этого портится внешний вид и разбивается дальше информация, вот код

Visual Basic

Sub dobavitj_tablicu()
    Dim Row&
    Row = Cells(1, 1).CurrentRegion.Rows.Count + 1
    [A2:G13].Copy
    Range("A" & Row & ":G" & (Row + 11)).Insert xlDown
    Range("A" & Row & ":D" & (Row + 3) & ",E" & Row & ":F" & (Row + 11) & _
        ",B" & (Row + 4) & ":D" & (Row + 5) & ",B" & (Row + 7) & ":" & "B" & _
        (Row + 8) & ",D" & (Row + 8)).ClearContents
End Sub

Результат при нажатии на кнопку на скрине, можно поправить чтоб небыло интервала в 3 строки и чтоб кнопка передвигалась вместе с таблицей вниз?

@strike383 · 24.07.2013, 12:48 **[ТС]**

починил, сделал отступ в 3 строки в таблице и все заработало ))
А можно еще добавить на против каждой таблице кнопку чтоб при нажатии можно было удалить ее?

@Step_UA · 24.07.2013, 12:49

Смещение кнопки в строку 15 или ниже должно решить обе проблемы ... или предоставляйте таблицу

@strike383 · 24.07.2013, 13:48 **[ТС]**

решил проблему смещение кнопки под таблицу и отступ в 3 строки

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

Добавлено через 15 минут
привязал к кнопки макрос

Visual Basic

Sub dobavitj_tablicu2()
    Dim Row&
    Row = Cells(1, 1).CurrentRegion.Rows.Count + 1
    [A2:G13].Delete
End Sub

как сделать чтоб не первая таблица удалялась а именно та, рядом с которой кнопка, и как сделать чтоб при нажатии кнопки добавить таблицу, вместе с ней добавлялась кнопка удалить?

Добавлено через 20 минут
сделал чтоб кнопка удалить появлялась с каждой таблицей, но проблема осталась, удаляется не та таблица рядом с которой кнопка, а первая, поправьте пожалуйста код

@Hugo121 · 24.07.2013, 14:06

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

или предоставляйте таблицу

- не заметили?

@strike383 · 24.07.2013, 14:20 **[ТС]**

тогда другой вопрос, наверно глупый, как сохранить таблицу с макросами? ))
создал макрос (Лист 1 - Исходный текст) в MicrosoftVisual Basic for Applications, нажимаю сохранить и мне пишет что мол "Следующие компоненты невозможно сохранить в книге без поддержки макросов ..."
Как только сохраню, сразу скину файл ))
В параметрах макросов включены все макросы

Dragokas · 24.07.2013, 15:37

strike383, сохраните книгу в формате XLSM
или в старом формате xls (2003), если книга не содержит специфических элементов, свойственных для вер. >=2007.

@strike383 · 24.07.2013, 17:22 **[ТС]**

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

strike383, сохраните книгу в формате XLSM
или в старом формате xls (2003), если книга не содержит специфических элементов, свойственных для вер. >=2007.

У меня версия 2010, сохраняю и в .xls и в .xlsm (в ручную прописываю), всеравно это сообщение появляется и сохраняет без макрос. Причем в типе файлов у меня только Книга Excel. Может я не правельно прописываю макросы? Я сегодня первый раз с ними сталкнулся ))
Может попробуешь сам сохранить, а я проверю откроется у меня и смогу ли сохранить изменения в готовом документе.
Во вложении сама таблица без макрос, вот код:

Visual Basic

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Range("E:E"), Target) Is Nothing Then
        If Application.Dialogs(xlDialogInsertPicture).Show Then
            With Selection
                .ShapeRange.LockAspectRatio = msoTrue
                .Height = Target.Height
                If .Width > Target.Width Then
                    .Width = Target.Width
                End If
            End With
        End If
    End If
End Sub
Sub dobavitj_tablicu()
    Dim Row&
    Row = Cells(1, 1).CurrentRegion.Rows.Count + 1
    [A2:H13].Copy
    Range("A" & Row & ":G" & (Row + 11)).Insert xlDown
    Range("A" & Row & ":D" & (Row + 3) & ",E" & Row & ":F" & (Row + 11) & _
        ",B" & (Row + 4) & ":D" & (Row + 5) & ",B" & (Row + 7) & ":" & "B" & _
        (Row + 8) & ",D" & (Row + 8)).ClearContents
End Sub
Sub udalit_tablicu()
    Dim Row&
    Row = Cells(1, 1).CurrentRegion.Rows.Count + 1
    [A2:H13].Delete
End Sub

Макросы назначаю кнопке Удалить - udalit_tablicu, и соответственнно Добавить - dobavitj_tablicu

Плюс проблему так и не решил, когда таблицу добавляю, все нормально, но когда нажимаю удалить, удаляется первая, а должна удаляться та, на против которой кнопка. Проблема конечно же в этой строчки [A2:H13].Delete , понятно что тут конкретно прописано что удалять таблицу по определенным координатам, я не знаю как прописать правельно чтоб удалялась та таблица на против которой кнопка.

@Hugo121 · 24.07.2013, 20:52

Пришлось убить кнопки - с ними не получалось, они при копировании не меняют имена...

@strike383 · 25.07.2013, 18:03 **[ТС]**

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

Пришлось убить кнопки - с ними не получалось, они при копировании не меняют имена...

Спасибо большое, все работает, и теперь стало появляться в типе файлов "сохранить с поддержкой макросов" ))

@strike383 · 25.07.2013, 18:59 **[ТС]**

Можете еще помочь? Вообщем таблица добавляется и удаляется без проблем нажатием кнопок, но есть несколько проблем. При нажатии на ячейку в столбце E, открывается окно вставка рисунка, когда рисунок вставлен, при нажатии кнопки копировать таблицу, она копируется с рисунком, можно сделать чтоб при копировании, ячейка E в новой таблице была пустая? Так же хотелось бы чтоб при копировании в столбце F проставлялось автоматом 1 , цена, почта, доп.упаковка 0 . Еще при удалении таблице чтоб удалялась и картинка вставленная в нее, а то таблица удаляется, картинки сдвигаются и накладывается одна на другую (которая должна быть удалена) в месте удаления. Так же хотелось бы чтоб удалялась и первая таблица при наличие других, то есть создаю 2-3 таблице нажатием кнопки, они удаляются без проблем, а первая не хочет, нужно чтоб можно было удалить любую таблицу, и первую тоже, если есть другие, а если таблица всего одна чтоб удаление не работало.
Еще почему то не могу вставить ссылку в соответствующее поле (объединены ячейки A,B,C,D 2,3,4,5) пишет что данные не совпадают по размеру и высоте, вставляется только есть прописать ее в ячейку A2 через строку формул. КОнечно было бы совсем классно еслиб ссылка с буфера обмена вставлялась автоматом при нажатии на соответствующие объединенные ячейки, без использования Ctrl + V. Сам файл я прикрепил. Заранее огромное спасибо!

@strike383 · 26.07.2013, 16:59 **[ТС]**

Никто не может помочь? Хотябы чтоб картинка вместе с таблицей удалялась можете поправить код?

@Hugo121 · 26.07.2013, 19:10

Чтоб картинка:

Visual Basic

Sub udalit_tablicu(adr)
    For Each sh In ActiveSheet.Shapes
        If sh.TopLeftCell.Address = Cells(adr, 5).Address Then
        sh.Delete
        Exit For
        End If
    Next
    Rows(adr & ":" & adr + 11).Delete
End Sub

@strike383 · 26.07.2013, 21:21 **[ТС]**

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

Чтоб картинка:

Visual Basic

Sub udalit_tablicu(adr)
    For Each sh In ActiveSheet.Shapes
        If sh.TopLeftCell.Address = Cells(adr, 5).Address Then
        sh.Delete
        Exit For
        End If
    Next
    Rows(adr & ":" & adr + 11).Delete
End Sub

не работает, копирую таблицу, вставляю картинку, таблицу удаляю а картинка остается

Добавлено через 1 минуту
тоже самое если вставляю картинку и копирую таблицу, все данные удаляются в новой таблице кроме картинки

Добавлено через 15 минут
оО, работает, но почему то 2 одни и те же картинки не удаляет, все остальные удаляет на ура, хотя все одного формата jpg

Добавлено через 7 минут
Глюк наверное какой то был.

Можешь еще поправить этот код

Visual Basic

Sub dobavitj_tablicu()
    Dim Row&
    Row = Cells(1, 1).CurrentRegion.Rows.Count + 1
    [A2:I13].Copy
    Range("A" & Row & ":G" & (Row + 11)).Insert xlDown
    Range("A" & Row & ":D" & (Row + 3) & ",E" & Row & ":F" & (Row + 11) & _
          ",B" & (Row + 4) & ":D" & (Row + 5) & ",B" & (Row + 7) & ":" & "B" & _
          (Row + 8) & ",D" & (Row + 8)).ClearContents
End Sub

при добавлении новой таблице все данные удаляются кроме картинки, можешь поправить код, чтоб в столбце E удалялась картинка, а так же в ячейке B9, B10, D10 не просто удалялись данные, а проставлялся 0, а в столбце F проставлялся 1

Добавлено через 4 минуты
и в этот код добавить возможность удалять самую первую таблицу в случае если их больше одной

Visual Basic

Sub udalit_tablicu(adr)
    For Each sh In ActiveSheet.Shapes
        If sh.TopLeftCell.Address = Cells(adr, 5).Address Then
        sh.Delete
        Exit For
        End If
    Next
    Rows(adr & ":" & adr + 11).Delete
End Sub

@strike383 · 28.07.2013, 03:04 **[ТС]**

помогите разобраться, с кодом для excel 2010,

1. При добавлении новой таблице все данные удаляются кроме картинки, можете поправить код, чтоб в столбце E удалялась картинка, а так же в ячейке B9, B10, D10 не просто удалялись данные, а проставлялся 0, а в столбце F проставлялся 1 :

Visual Basic

Sub dobavitj_tablicu()
    Dim Row&
    Row = Cells(1, 1).CurrentRegion.Rows.Count + 1
    [A2:I13].Copy
    Range("A" & Row & ":G" & (Row + 11)).Insert xlDown
    Range("A" & Row & ":D" & (Row + 3) & ",E" & Row & ":F" & (Row + 11) & _
          ",B" & (Row + 4) & ":D" & (Row + 5) & ",B" & (Row + 7) & ":" & "B" & _
          (Row + 8) & ",D" & (Row + 8)).ClearContents
End Sub

2. В этот код добавить возможность удалять самую первую таблицу в случае если их больше одной, сейчас первую таблицу удалить нельзя:

Visual Basic

Sub udalit_tablicu(adr)
    For Each sh In ActiveSheet.Shapes
        If sh.TopLeftCell.Address = Cells(adr, 5).Address Then
        sh.Delete
        Exit For
        End If
    Next
    Rows(adr & ":" & adr + 11).Delete
End Sub

@Hugo121 · 28.07.2013, 11:32

В коде удаления таблицы нет никакой привязки к тому, какая таблица удаляется.
Т.е. его показывать/менять смысла нет - там прекрасно удалится любая таблица, только дай

А я не давал - потому что если дать, то юзер всё поудаляет, и что затем копировать?
Если давать удалять всё - значит нужно шаблон таблицы держать где-то в другом месте. Например на другом листе, возможно скрытом. Или же контролировать количество таблиц и не давать удалять последнюю.
В обоих случаях нужно значительно менять код. А некогда...

@strike383 · 28.07.2013, 11:46 **[ТС]**

Эта таблица только для меня, так что подскажи как сделать чтоб удалялась любая таблица?

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
		1
	Макрос копирования таблиц нажатием кнопки 24.07.2013, 08:51. Показов 5141. Ответов 23 Метки нет (Все метки) Здравствуйте, нужна помощь. Есть таблица с формулами (см. Снимок). Нужно чтоб при нажатии на кнопку (слева от таблице), создавалась такая же таблица с теми же формулами ниже (или выше) имеющейся, причем текстовые поля выделенные жирным должны сохраниться, остальные ячейки пустые. Кнопку я создал, не могу написать макрос, в результате нажатия на кнопку, должно получиться следующее (см. Снимок 2). Причем если несколько раз нажимать на кнопку, нужно чтоб таблица добавлялась на каждое нажатие. У меня excel 2010, если это важно. Миниатюры 0

@Step_UA 1589 / 662 / 225 Регистрация: 09.06.2011 Сообщений: 1,334
	24.07.2013, 09:37	2
	Можно так ... Миниатюры 1

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	24.07.2013, 11:02 [ТС]	3
	а можешь написать относительно моей таблицы? А то я с макросами не дружу (( 0

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	24.07.2013, 12:48 [ТС]	5
	починил, сделал отступ в 3 строки в таблице и все заработало )) А можно еще добавить на против каждой таблице кнопку чтоб при нажатии можно было удалить ее? 0

@Step_UA 1589 / 662 / 225 Регистрация: 09.06.2011 Сообщений: 1,334
	24.07.2013, 12:49	6
	Смещение кнопки в строку 15 или ниже должно решить обе проблемы ... или предоставляйте таблицу 1

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	24.07.2013, 14:06	8
	Сообщение от Step_UA или предоставляйте таблицу - не заметили? 0

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	24.07.2013, 14:20 [ТС]	9
	тогда другой вопрос, наверно глупый, как сохранить таблицу с макросами? )) создал макрос (Лист 1 - Исходный текст) в MicrosoftVisual Basic for Applications, нажимаю сохранить и мне пишет что мол "Следующие компоненты невозможно сохранить в книге без поддержки макросов ..." Как только сохраню, сразу скину файл )) В параметрах макросов включены все макросы Миниатюры 0

Dragokas 17996 / 7697 / 892 Регистрация: 25.12.2011 Сообщений: 11,470 Записей в блоге: 16
	24.07.2013, 15:37	10
	strike383, сохраните книгу в формате XLSM или в старом формате xls (2003), если книга не содержит специфических элементов, свойственных для вер. >=2007. 0

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	25.07.2013, 18:03 [ТС]	13
	Сообщение от Hugo121 Пришлось убить кнопки - с ними не получалось, они при копировании не меняют имена... Спасибо большое, все работает, и теперь стало появляться в типе файлов "сохранить с поддержкой макросов" )) 0

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	26.07.2013, 16:59 [ТС]	15
	Никто не может помочь? Хотябы чтоб картинка вместе с таблицей удалялась можете поправить код? 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	28.07.2013, 11:32	19
	В коде удаления таблицы нет никакой привязки к тому, какая таблица удаляется. Т.е. его показывать/менять смысла нет - там прекрасно удалится любая таблица, только дай А я не давал - потому что если дать, то юзер всё поудаляет, и что затем копировать? Если давать удалять всё - значит нужно шаблон таблицы держать где-то в другом месте. Например на другом листе, возможно скрытом. Или же контролировать количество таблиц и не давать удалять последнюю. В обоих случаях нужно значительно менять код. А некогда... 0

@strike383 616 / 0 / 1 Регистрация: 24.07.2013 Сообщений: 93
	28.07.2013, 11:46 [ТС]	20
	Эта таблица только для меня, так что подскажи как сделать чтоб удалялась любая таблица? 0