Excel сохранение формата при копировании макрос
Привожу простой пример:
Жмем на кнопку и макрос делает два действия:
1. Копирует в этой же книге данные листа1 на лист2 (все ок цвет ячейки тот же)
2. Копирует в другую книгу данные листа1 на лист1 искажает цвет ячейки)
Дело даже не в макросе, при простом копировании происходит тоже самое.
Но почему? Как с этим бороться. Всякое пробовал, но ничего не получилось.
Изначально задача стоит в копировании определенного диапазона из одной книги в другую с сохранением всех форматов а так же размера столбцов и строк.
Привожу простой пример:
Жмем на кнопку и макрос делает два действия:
1. Копирует в этой же книге данные листа1 на лист2 (все ок цвет ячейки тот же)
2. Копирует в другую книгу данные листа1 на лист1 искажает цвет ячейки)
Дело даже не в макросе, при простом копировании происходит тоже самое.
Но почему? Как с этим бороться. Всякое пробовал, но ничего не получилось.
Изначально задача стоит в копировании определенного диапазона из одной книги в другую с сохранением всех форматов а так же размера столбцов и строк. skais
Дело даже не в макросе, при простом копировании происходит тоже самое.
Но почему? Как с этим бороться. Всякое пробовал, но ничего не получилось.
Изначально задача стоит в копировании определенного диапазона из одной книги в другую с сохранением всех форматов а так же размера столбцов и строк. Автор - skais
Дата добавления - 08.11.2017 в 14:23
Наверное, цветовая схема другая (в разных файлах она м.б. разная)
Посмотрите на ленте вкладка Разметка страницы - группа Темы - кнопка Цвета.
Наверное, цветовая схема другая (в разных файлах она м.б. разная)
Посмотрите на ленте вкладка Разметка страницы - группа Темы - кнопка Цвета. nilem
nilem, Посмотреть посмотрел, но мало что понял из этого, даже при смене цветов ничего не изменилось.
Лучшим ответом будет демонстрация решения на примере моего файла.
nilem, Посмотреть посмотрел, но мало что понял из этого, даже при смене цветов ничего не изменилось.
Лучшим ответом будет демонстрация решения на примере моего файла. skais
Привет.
Проблема такая. у меня в таблице есть много полей,и одно из них индикатор.
В роли индикатора выступает цвет ячейки.
Как мне скопировать на другой лист сохраняя цвет этой ячейки!?
У меня организованная связь с другим файлом в котором хранятся эти цвета.как через связи передать цвет ячейки в другой файл..Пожалуйсто очень нужно
Копирование с сохранением форматирования
Есть код, With GetObject("c:\temp\mydoc.docx") 'путь к файлу myVar = .Range.Text 'текст файла.
Объединение столбцов в Excel по порядку с сохранением форматирования ячеек
Здравствуйте! Данный код объединяет несколько столбцов с данными 1 2 3 1 2 3 2 3 .
Копирование данных с сохранением формата исходных ячеек
Доброго времени суток. Совсем не разбираюсь в написании макросов, пользуюсь похожими. .
Вставка в таблицу строк с сохранением форматирования
Доброе время суток. Подскажите пожалуйста как при помощи макроса возможно вставить в таблицу.
два отдельных файла, связанные фомулами ИМХО ненадежное решение, т.к. файлы могут переименовываться, переноситься, поочередно открываться и по отдельности редактироваться, сохраняться и т.д. Здесь потенциальный источник ошибок в будущем. Способа при помощи формулы по связи узнать цвет ячейки я не знаю. При помощи макроса можно запрограммировать перенос данных с цветом заливки ячеек из одной книги в другую, зная поточней, по какому правилу связаны две книги. Выкладывайте лучше обе книги и объясняйте)
Вот. думаю суть поймете.
Ответте только на один вопрос как мне через связь передать цвет ячейки!?
(Я думаю при просмотре вы увидите Столбец индикатор так вот из него мне нужно передавать цвета в главную)
Не могу скинуть файл ограничение по одьему.
Можно или засунуть файл в архив. Либо выхватить из файла фрагмент, отражающий суть, так чтобы утрированный пример отражал проблему. В крайнем случае положите на файлообменник и дайте ссылку.
http://ifolder.ru/29719657
Вот приложил туда все файлы.
Суть. так как там была информация компании я вс стер.
Весь код находится на Главной странице файла All in 1 на кнопе "Обновить"
Столбец H в любом из других файлов "Индикатор" имеет цветовые окраски их мне и надо переташить в файл All In 1.
В котором имеются скрытые листы.
Через связь думаю цвет вы не передадите. Напишите макрос, который будет смотреть цвет на нужном листе и окрашивать ячейку на общем. Цвет можно передать копированием ячейки. Но если нужно именно через связь, тогда VBA вам в помощь.
Я и прошу помоши в ВБА.Я не понимаю как передать.
ЕСть способ передать цвет не открывая файлы которые через связь контактируют и хранятся в другом месте??
Свыше 30 МБ в zip, мой трафик на работе не позволит, извините. Что до передачи цвета по связям без открытия файлов - это невозможно (на мой взгляд), а макрос работает только с открытым файлом.
Моя идея для макроса в общих чертах: в сводном файле перечислить коллекцию внешних связей в цикле; на каждом шаге открывать файл по связи, затем находить с водной диапазон ссылок на этот файл и по ссылкам получать ячейку (src.Cells(i,j)), на которую идет ссылка и из этой ячейки брать значение цвета заливки (src.Cells(i,j).Interior.ColorIndex) и подставлять эти значения в соотв. ячейку сводной таблицы. Как-то так.
Но если подходить так, то по ходу надо попросту избавляться от внешних ссылок при помощи списка файлов и алгоритма в макросе делать периодическое копирование значений с учетом форматирования (цвета заливки ячеек).
Работая с большой книгой в Excel в один совсем не прекрасный момент вы делаете что-то совершенно безобидное (добавление строки или вставку большого фрагмента ячеек, например) и вдруг получаете окно с ошибкой "Слишком много различных форматов ячеек":
Почему это происходит
Такая ошибка возникает, если в рабочей книге превышается предельно допустимое количество форматов, которое Excel может сохранять:
- для Excel 2003 и старше - это 4000 форматов
- для Excel 2007 и новее - это 64000 форматов
Причем под форматом в данном случае понимается любая уникальная комбинация параметров форматирования:
- шрифт
- заливки
- обрамление ячеек
- числовой формат
- условное форматирование
Так, например, если вы оформили небольшой фрагмент листа подобным образом:
. то Excel запомнит в книге 9 разных форматов ячеек, а не 2, как кажется на первый взгляд, т.к. толстая линия по периметру создаст, фактически 8 различных вариантов форматирования. Добавьте к этому дизайнерские танцы со шрифтами и заливками и тяга к красоте в большом отчете приведет к появлению сотен и тысяч подобных комбинаций, которые Excel будет вынужден запоминать. Размер файла от этого, само собой, тоже не уменьшается.
Подобная проблема также часто возникает при многократном копировании фрагментов из других файлов в вашу рабочую книгу (например при сборке листов макросом или вручную). Если не используется специальная вставка только значений, то в книгу вставляются и форматы копируемых диапазонов, что очень быстро приводит к превышению лимита.
Как с этим бороться
Направлений тут несколько:
- Если у вас файл старого формата (xls), то пересохраните его в новом (xlsx или xlsm). Это сразу поднимет планку с 4000 до 64000 различных форматов.
- Удалите избыточное форматирование ячеек и лишние "красивости" с помощью команды Главная - Очистить - Очистить форматы (Home - Clear - Clear Formatting) . Проверьте, нет ли на листах строк или столбцов отформатированных целиком (т.е. до конца листа). Не забудьте про возможные скрытые строки и столбцы.
- Проверьте книгу на наличие скрытых и суперскрытых листов - иногда на них и кроются "шедевры".
- Удалите ненужное условное форматирование на вкладке Главная - Условное форматирование - Управление правилами - Показать правила форматирования для всего листа (Home - Conditional Formatting - Show rules for this worksheet) .
- Проверьте, не накопилось ли у вас избыточное количество ненужных стилей после копирования данных из других книг. Если на вкладке Главная (Home) в списке Стили (Styles) огромное количество "мусора":
Запустить его можно с помощью сочетания клавиш Alt+F8 или кнопкой Макросы (Macros) на вкладке Разработчик (Developer) . Макрос удалит все неиспользуемые стили, оставив только стандартный набор:
У меня есть книга Excel, которая при нажатии кнопки формы я хочу сохранить копию книги с именем файла, являющимся текущей датой.
Я пытаюсь следующее ActiveWorkbook.SaveAs ("filePathFormFlow To MSExcel" & Left(Now(), 10)) но получив Run-time error '1004': Method 'SaveAs' of object'_Workbook' failed.
может кто-нибудь помочь мне с этим? Я все еще очень новичок в разработке для Excel.
скорее всего, путь, к которому вы пытаетесь получить доступ, не существует. Кажется, вы пытаетесь сохранить в относительном месте, и у вас нет расширения файла в этой строке. Если вам нужно использовать относительные пути, вы можете проанализировать путь из ActiveWorkbook.FullName
изменить: Лучшим синтаксисом также будет
самый простой способ использовать эту функцию-начать с "записи макроса". Как только вы начнете запись, сохраните файл в нужном месте с нужным именем, а затем, конечно, установите тип файла, скорее всего, "Excel Macro Enabled Workbook" ~ "XLSM"
остановить запись, и вы можете начать проверку кода.
Я написал код ниже, который позволяет сохранить книгу, используя путь, где файл был первоначально расположен, назвав его как " событие [дата в ячейке "А1"]"
скопируйте код в новый модуль, а затем напишите дату в ячейке" A1", например 01-01-2016 -> назначьте sub кнопке и запустите. [Примечание] вам нужно сделать файл сохранения, прежде чем этот скрипт будет работать, потому что новая книга сохраняется в папку автосохранения по умолчанию!
возможно, ваш формат по умолчанию не соответствует расширению файла. Вы должны указать формат файла вместе с именем файла, убедившись, что формат соответствует расширению:
OTOH, я не вижу расширения на вашем .Сохранить как имя файла. Возможно, вам нужно предоставить его при выполнении этого программно. Это имеет смысл-не нужно предоставлять расширение из интерфейса GUI удобно, но мы, программисты, должны писать однозначный код. Я предлагаю добавление расширения и соответствующего формата. См.эта страница msdn для списка форматов файлов. Честно говоря, я не узнаю много о descripions.
xlExcel8 = 56-это .формат xls
xlExcel12 = 50-это .файл xlsb формате
xlOpenXMLWorkbook = 51 является .формат xlsx
xlOpenXMLWorkbookMacroEnabled = 52 является .формата xlsm
xlWorkbookDefault является и указан со значением 51, что озадачивает меня, так как я думал, что формат по умолчанию может быть изменен.
Я знаю, что это старый пост, но я искал что-то подобное. Я думаю, ваша проблема заключалась в том, что при использовании Now () выход будет "6/20/2014". Это проблема для имени файла, поскольку в нем есть"/". Как вы знаете, нельзя использовать определенные символы в имени файла.
Всем доброго времени суток. В продолжении ЭТОЙ ТЕМЫ
Макрос и таблица успешно работают, но у босса возникло желание, что бы на листах Октябрь и контроль выполнения графика форматирование столбцов A-D абсолютно совпадало.
Своих знаний как сделать не хватает. Что добавит в уже готовый и рабочий макрос?
Dim r0 As Long, r1 As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'При выделении любой ячейки листа, запоминайем
'номер последней строчки в толбце С
r0 = 0
r0 = Cells(Rows.Count, "c").End(xlUp).Row
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'При изменении любой ячейки листа, запоминайем
'номер последней строчки в толбце С и сравниваем
'его со старым значением r0
r1 = 0
r1 = Cells(Rows.Count, "c").End(xlUp).Row
If r1 < r0 Then 'если новое значение меньше предыдущего, значит строчек поубавилось :)
rt = r0 - r1 'запоминаем сколько строчек удалили
'удаляем столько же строчек на листе контроль
Sheets("контроль выполнения графика").Range(Target.Address).Offset(0).Resize(rt).Delete
ElseIf r1 > r0 Then 'если новое значение больше предыдущего, значит строчки добавились
rt = r1 - r0 'запоминаем сколько строчек вставили
'вставляем строчки на листе контроль
Sheets("контроль выполнения графика").Range(Target.Address).Offset(0).Resize(rt).Insert Shift:=xlDown
End If
'копируем значения из диапазона K6:FP1000
Set Rng = Intersect(Target, Range("O11:AQ" & r1))
If Not Rng Is Nothing Then
'на листе контроль, сдвигаемся на 1 строчку вверх и на 3 столбца вправо
Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0, 0).Value = Rng.Value
End If 'копируем значения из диапазона A6:H1000
Set Rng = Intersect(Target, Range("A11:I" & r1))
If Not Rng Is Nothing Then
Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0).Value = Rng.Value
End If
End Sub
Всем доброго времени суток. В продолжении ЭТОЙ ТЕМЫ
Макрос и таблица успешно работают, но у босса возникло желание, что бы на листах Октябрь и контроль выполнения графика форматирование столбцов A-D абсолютно совпадало.
Своих знаний как сделать не хватает. Что добавит в уже готовый и рабочий макрос?
Dim r0 As Long, r1 As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'При выделении любой ячейки листа, запоминайем
'номер последней строчки в толбце С
r0 = 0
r0 = Cells(Rows.Count, "c").End(xlUp).Row
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'При изменении любой ячейки листа, запоминайем
'номер последней строчки в толбце С и сравниваем
'его со старым значением r0
r1 = 0
r1 = Cells(Rows.Count, "c").End(xlUp).Row
If r1 < r0 Then 'если новое значение меньше предыдущего, значит строчек поубавилось :)
rt = r0 - r1 'запоминаем сколько строчек удалили
'удаляем столько же строчек на листе контроль
Sheets("контроль выполнения графика").Range(Target.Address).Offset(0).Resize(rt).Delete
ElseIf r1 > r0 Then 'если новое значение больше предыдущего, значит строчки добавились
rt = r1 - r0 'запоминаем сколько строчек вставили
'вставляем строчки на листе контроль
Sheets("контроль выполнения графика").Range(Target.Address).Offset(0).Resize(rt).Insert Shift:=xlDown
End If
'копируем значения из диапазона K6:FP1000
Set Rng = Intersect(Target, Range("O11:AQ" & r1))
If Not Rng Is Nothing Then
'на листе контроль, сдвигаемся на 1 строчку вверх и на 3 столбца вправо
Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0, 0).Value = Rng.Value
End If 'копируем значения из диапазона A6:H1000
Set Rng = Intersect(Target, Range("A11:I" & r1))
If Not Rng Is Nothing Then
Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0).Value = Rng.Value
End If
End Sub
Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852
Dim r0 As Long, r1 As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'При выделении любой ячейки листа, запоминайем
'номер последней строчки в толбце С
r0 = 0
r0 = Cells(Rows.Count, "c").End(xlUp).Row
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'При изменении любой ячейки листа, запоминайем
'номер последней строчки в толбце С и сравниваем
'его со старым значением r0
r1 = 0
r1 = Cells(Rows.Count, "c").End(xlUp).Row
If r1 < r0 Then 'если новое значение меньше предыдущего, значит строчек поубавилось :)
rt = r0 - r1 'запоминаем сколько строчек удалили
'удаляем столько же строчек на листе контроль
Sheets("контроль выполнения графика").Range(Target.Address).Offset(0).Resize(rt).Delete
ElseIf r1 > r0 Then 'если новое значение больше предыдущего, значит строчки добавились
rt = r1 - r0 'запоминаем сколько строчек вставили
'вставляем строчки на листе контроль
Sheets("контроль выполнения графика").Range(Target.Address).Offset(0).Resize(rt).Insert Shift:=xlDown
End If
'копируем значения из диапазона K6:FP1000
Set Rng = Intersect(Target, Range("O11:AQ" & r1))
If Not Rng Is Nothing Then
'на листе контроль, сдвигаемся на 1 строчку вверх и на 3 столбца вправо
Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0, 0).Value = Rng.Value
End If 'копируем значения из диапазона A6:H1000
Set Rng = Intersect(Target, Range("A11:I" & r1))
If Not Rng Is Nothing Then
Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0).Value = Rng.Value
End If
End Sub
Игорь, привет!
Можно в Worksheet_Change листа "Сентябрь" 7-ю снизу строку (после =========, его я написал, чтобы обозначить место) переписать так
[vba]
If Not Rng Is Nothing Then
'на листе контроль, сдвигаемся на 1 строчку вверх и на 3 столбца вправо
'==========================
Rng.Copy Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0, 0)
End If 'копируем значения из диапазона A6:H1000
Set Rng = Intersect(Target, Range("A11:I" & r1))
If Not Rng Is Nothing Then
Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0).Value = Rng.Value
End If
[/vba]
Но дело в том, что у тебя на листе "Контроль" при активации листа срабатывает макрос, красящий цифры в голубой цвет. Поэтому такой же формат все равно не получится. Если этот голубой тебе, конечно, так дорог
Добавлено
Ну и вторую строку снизу тоже конечно
Файл перевложил
=======
Это если я правильно понял твой вопрос
Игорь, привет!
Можно в Worksheet_Change листа "Сентябрь" 7-ю снизу строку (после =========, его я написал, чтобы обозначить место) переписать так
[vba]
If Not Rng Is Nothing Then
'на листе контроль, сдвигаемся на 1 строчку вверх и на 3 столбца вправо
'==========================
Rng.Copy Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0, 0)
End If 'копируем значения из диапазона A6:H1000
Set Rng = Intersect(Target, Range("A11:I" & r1))
If Not Rng Is Nothing Then
Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0).Value = Rng.Value
End If
[/vba]
Но дело в том, что у тебя на листе "Контроль" при активации листа срабатывает макрос, красящий цифры в голубой цвет. Поэтому такой же формат все равно не получится. Если этот голубой тебе, конечно, так дорог
Добавлено
Ну и вторую строку снизу тоже конечно
Файл перевложил
=======
Это если я правильно понял твой вопрос _Boroda_
If Not Rng Is Nothing Then
'на листе контроль, сдвигаемся на 1 строчку вверх и на 3 столбца вправо
'==========================
Rng.Copy Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0, 0)
End If 'копируем значения из диапазона A6:H1000
Set Rng = Intersect(Target, Range("A11:I" & r1))
If Not Rng Is Nothing Then
Sheets("контроль выполнения графика").Range(Rng.Address).Offset(0).Value = Rng.Value
End If
[/vba]
Но дело в том, что у тебя на листе "Контроль" при активации листа срабатывает макрос, красящий цифры в голубой цвет. Поэтому такой же формат все равно не получится. Если этот голубой тебе, конечно, так дорог
Добавлено
Ну и вторую строку снизу тоже конечно
Файл перевложил
=======
Это если я правильно понял твой вопрос Автор - _Boroda_
Дата добавления - 04.09.2017 в 10:37
Читайте также: