Worksheets("B").Range("A1").Copy
Worksheets("C").Range("A1").PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False 'необязательно
Копирование формата ячейки. Не удается программно скопировать формат
Привет, Рад вашему вниманию!
Есть проблема.
Пытаюсь сделать подпрограмму, которая, активируясь на рабочем листе "А" копирует формат некоторой ячейки листа "В" в некоторую ячейку листа "С", при этом явно не активируя ни "В" ни "С" листы.
Пытался по всякому реализовать, даже через буфер обмена. Всё время вылезают ошибки времени выполнения.
Подскажите, как решить эту элементарную задачу.
Есть проблема.
Пытаюсь сделать подпрограмму, которая, активируясь на рабочем листе "А" копирует формат некоторой ячейки листа "В" в некоторую ячейку листа "С", при этом явно не активируя ни "В" ни "С" листы.
Пытался по всякому реализовать, даже через буфер обмена. Всё время вылезают ошибки времени выполнения.
Подскажите, как решить эту элементарную задачу.
Код:
Примечание : Если рабочий лист "C" и ячейка "A1" защищены, то скорее всего возникнет ошибка.
pashulka, спасибо.
Но весь прикол в том, сто первая из строк (с операцией Copy) вызовет ошибку времени выполнения.
Subscript out of range (Error 9)
Поэкспериментируй на своей машине. Думаю, это не случайный глюк моей системы.
Но весь прикол в том, сто первая из строк (с операцией Copy) вызовет ошибку времени выполнения.
Subscript out of range (Error 9)
Поэкспериментируй на своей машине. Думаю, это не случайный глюк моей системы.
Хотя, мда... Сам попробовал - в чистом виде в новой книге прошло без проблем. Буду разбираться, что не так. Защиты ячеек и листов нет.
Ошибку при копировании можно получить, если попытаться скопировать диапазон ячеек в котором наличествуют об'единённые ячейки, область которых выходит за пределы копируемого диапазона, но в этом случае номер ошибки будет 1004. P.S. Если ошибка будет повторяться, то можно выложить рабочую книгу, содержащую проблемный лист, а также текст Вашего макроса.
Цитата:
Originally posted by pashulka
Ошибку при копировании можно получить, если попытаться скопировать диапазон ячеек в котором наличествуют об'единённые ячейки...
Ошибку при копировании можно получить, если попытаться скопировать диапазон ячеек в котором наличествуют об'единённые ячейки...
pashulka, спасибо. Объединенных ячеек нет.
текст подпрограммы сбрасывать пока рано. Там фактически срабатывает процедура обработки листа "А" Private Sub Worksheet_Change.
Она вызывает функцию, которая собственно переносит отдельные форматы с листа "B" на "C".
Как ясно из сказанного, оказывать влияние на возникновение ошибки может многое. Прежде чем высылать текст программы я все-таки попытаюсь еще покорпеть сам, чтобы хотя бы локализовать проблему, отсеив все не влияющие факторы.
Ведь, как я убедился, в чистой книге с нуля команда Copy в описанных условиях не глючит.
Ну, вот. Выделил причину достаточно быстро:
в нотации
Range("А1").Copy
работает.
а вот
Range(Cells(1, 1), Cells(1, 1)).Copy
уже нет.
Вопрос теперь следующий.
Как заменить неработающую строку, если номер колонки и строки копируемой ячейки определяются некоторыми переменными?
в нотации
Range("А1").Copy
работает.
а вот
Range(Cells(1, 1), Cells(1, 1)).Copy
уже нет.
Вопрос теперь следующий.
Как заменить неработающую строку, если номер колонки и строки копируемой ячейки определяются некоторыми переменными?
Вот яркий пример, когда опубликованный код/книга помогли бы сразу выявить проблему.
Код:
iAddress$ = Range(Cells(1, 1), Cells(1, 1)).Address
Worksheets("B").Range(iAddress$).Copy
Worksheets("C").Range(iAddress$).PasteSpecial Paste:=xlFormats
Worksheets("B").Range(iAddress$).Copy
Worksheets("C").Range(iAddress$).PasteSpecial Paste:=xlFormats
Код:
Set iListB = Worksheets("B")
Set iListC = Worksheets("C")
iListB.Range(iListB.Cells(1, 1), iListB.Cells(1, 1)).Copy
iListC.Range(iListC.Cells(1, 1), iListC.Cells(1, 1)).PasteSpecial Paste:=xlFormats
Set iListC = Worksheets("C")
iListB.Range(iListB.Cells(1, 1), iListB.Cells(1, 1)).Copy
iListC.Range(iListC.Cells(1, 1), iListC.Cells(1, 1)).PasteSpecial Paste:=xlFormats
Код:
With Worksheets("B")
.Range(.Cells(1, 1), .Cells(1, 1)).Copy
End With
With Worksheets("C")
.Range(.Cells(1, 1), .Cells(1, 1)).PasteSpecial Paste:=xlFormats
End With
.Range(.Cells(1, 1), .Cells(1, 1)).Copy
End With
With Worksheets("C")
.Range(.Cells(1, 1), .Cells(1, 1)).PasteSpecial Paste:=xlFormats
End With
При много благодарен за варианты!
Теперь все заработает!
Теперь все заработает!
Цитата:
Originally posted by pashulka
Вот яркий пример, когда опубликованный код/книга помогли бы сразу выявить проблему.
[/CODE]
Вот яркий пример, когда опубликованный код/книга помогли бы сразу выявить проблему.
[/CODE]
Должен заметить, что исходный код был совсем не таким, нежели код с локализованной проблемой. Он был намного сложнее. И чтобы его разобрать, нужно было бы копировать 2 экрана исходников. В ряд ли кому-то интересно читать этот бред. Вот результат в одну -две строки, который я дал, мне кажется как раз тот вариант, который достоин публикации на форуме. Или не прав?
Вот весь код:
Public Function aa(aa1 As Integer, aa2 As String) 'Печать типа
'aa1 - номер печатаемого типа.
'aa2 - номер раздела, содержимое которого заполнит таблицу
Const aa3 = 8 ' номер строки, с которой рисуется шапка таблицы на листе отрисовки
Const aa4 = 11 ' номер колонки, с которой рисуется шапка таблицы на листе
Dim aa5 As Integer ' номер строки по листу типы
Dim aa6 As Integer ' номер очередного типа в таблице типов
Dim aa7 As Byte ' номер активной версии таблицы
Const aa8 = 1 ' номер колонки, на листе описателе типов, в которой проставлены номера типов
Const aa9 = 11 ' номер строки на листе описателе типов, с которой проставлены номера типов
Dim aa10 As Integer ' номер первой строки, принадлежащей данному типу на листе описателе типов
Dim aa11 As Integer ' номер текущего типа на листе описателе типов
Dim aa12 As Integer ' номер очередной строки, принадлежащей данному типу на листе описателе типов
Const aa13 = 10 ' номер колонки, с которой отрисовывается генерируемая таблица
Dim aa14 As Byte ' номер колонки, в которой отрисовывается обрабатываемое поле рисуемой таблицы
Const aa15 = 19 'номер колонки с текстовым описанием шапок таблиц в таблице-описателе типов.
'Const aa16 = "Экран" ' лист, на котором отрисовывается таблица
Dim aa17 As String 'шапка очередной колонки
Dim aa18 As Byte ' ширина очередного столбца
Const aa19 = 12 ' номер колонки, в которую прописывается ширина колонок в описателе таблиц
Const aa20 = 25 ' номер колонки, в которую прописывается формат ячеек колонок в описателе таблиц
Dim aa21 As Range 'формат ячеек
aa5 = 10
aa6 = Worksheets("Типы").Cells(aa5, 2)
While aa6 <> 0 And aa6 <> aa1
aa5 = aa5 + 1
aa6 = Worksheets("Типы").Cells(aa5, 2)
Wend
If aa6 <> 0 Then 'значит тип идентифицирован. он в aa5 строке
aa7 = Worksheets("Типы").Cells(aa6, 9)
If aa7 = 0 Then Worksheets("Типы").Cells(aa6, 9) = 1: aa7 = 1 'если версия не проставлена- значит проставить первую
aa10 = aa9
aa11 = Worksheets("Описатель типов").Cells(aa10, aa8)
While aa11 <> 0 And aa11 <> aa1
aa10 = aa10 + 1
aa11 = Worksheets("Описатель типов").Cells(aa10, aa8)
Wend
If aa11 = aa1 Then 'найдена соответствующая строка в таблице-описателе типов.
'Прорисовываем шапку раздела
aa12 = aa10
aa11 = Worksheets("Описатель типов").Cells(aa12, aa8)
While aa11 = aa1
aa14 = aa13 - 1 + Worksheets("Описатель типов").Cells(aa12, 2 + aa7)
aa17 = Worksheets("Описатель типов").Cells(aa12, aa15)
Worksheets(aa16).Cells(aa3, aa14) = aa17
aa18 = Worksheets("Описатель типов").Cells(aa12, 12)
'прорисовка формата заголовка (with не использую, так как тут тоже глюки были, решил коряво прописать - лишь бы работало.
Worksheets(aa16).Cells(aa3, aa14).ColumnWidth = aa18
Worksheets(aa16).Cells(aa3, aa14).NumberFormat = "@"
Worksheets(aa16).Cells(aa3, aa14).HorizontalAlignment = xlCenter
Worksheets(aa16).Cells(aa3, aa14).VerticalAlignment = xlCenter
Worksheets(aa16).Cells(aa3, aa14).WrapText = True
Worksheets(aa16).Cells(aa3, aa14).Orientation = 90
Worksheets(aa16).Cells(aa3, aa14).AddIndent = False
Worksheets(aa16).Cells(aa3, aa14).IndentLevel = 0
Worksheets(aa16).Cells(aa3, aa14).ShrinkToFit = False
Worksheets(aa16).Cells(aa3, aa14).ReadingOrder = xlContext
Worksheets(aa16).Cells(aa3, aa14).MergeCells = False
'копирование формата ячеек колонки в первую строку данных
[COLOR=skyblue]aa21 = Worksheets("Описатель типов").Range(Cells(aa12, aa20), Cells(aa12, aa20))[/COLOR]' эта строка и есть причина ошибки. Она прописывалась по разному, в том числе и через Copy.
Worksheets(aa16).Cells(aa3 + 2, aa14) = aa21
aa12 = aa12 + 1
aa11 = Worksheets("Описатель типов").Cells(aa12, aa8)
Wend
Else
'нет такого типа в таблице описания известных типов
End If
Else
'нет такого типа в таблице известных типов
End If
End Function
Ну как? Извиняюсь за корявое программирование. Варюсь в собственном соку. И книг по VBA и объектному программированию не читал.
Ну я первоначально вообще предлагал выложить всю книгу целиком, естественно с минимальным количеством информации, а после решения проблемы опубликовывать код вроде как и не зачем ...
Цитата:
Originally posted by pashulka
... а после решения проблемы опубликовывать код вроде как и не зачем ...
... а после решения проблемы опубликовывать код вроде как и не зачем ...
Спасибо большое. Всё уже действительно работает.
Теперь двигаюсь дальше. Еще много предстоит делать. Это только первые шаги в задумке.
Основная идея сделать некоторую таблицу описатель форматов стандартных таблиц в некоторой Excel-евской базе данных. А затем выбирая лишь тип нужной таблицы заставлять Excel программно отрисовывать бланк этой таблицы на некотором листе и автоматически переносить в эту таблицу данные из некоторого раздела базы данных.