Помогите создать автомат для этикеток. Ставишь в верхний левый угол (место для нужной этикетки), отвечаешь на Input(номер строки исходной таблицы) и радуешься. Можно наброском мыслей,если нет времени
{quote}{login=Rezh}{date=02.11.2009 09:35}{thema=}{post}Попробую перевести это на VBA{/post}{/quote}
Если бы в данном случае имело смысл использовать макросы для заполнения этикеток - я бы так и сделал. (мне проще написать макрос, чем простейшую формулу)
Но в данном случае формул более чем достаточно... Зачем Вам именно макрос?
Больше интересует процесс чем результат. Меня например поражает логика создания этой формулы на растягивание. Сам бы никогда такого придумать не смог С другой стороны понимаю,что это приемчик который надо знать К VBA примерно отношение такое же. С уважением, Rezh.
Sub СоздатьКвиточки() Dim cell As Range, ra As Range, n As Long: Application.ScreenUpdating = False Set ra = Range([d5], Range("d" & Rows.Count).End(xlUp)) Dim Квиточки As Worksheet: Set Квиточки = Worksheets.Add(, Worksheets(Worksheets.Count)) Квиточки.Name = "Квиточки " & Format(Now, "DD-MM-YYYY HH-NN-SS") With Квиточки.PageSetup .Zoom = False: .FitToPagesWide = 1: .FitToPagesTall = 1000 End With
n = 0 ' номер квитка For Each cell In ra.Cells ' перебираем все заполненные фамилии If Len(cell) > 2 Then ' если длина фамилии больше, чем 2 символа [Кооператив] = cell.Previous [показатель1] = cell.Next: [показатель2] = cell.Next.Next [ФИО] = cell: [Сумма] = cell.Offset(, 4) ДобавитьКвитокНаЛист Квиточки, n n = n + 1 End If Next cell Квиточки.Tab.Color = vbGreen: ActiveSheet.ResetAllPageBreaks: ActiveWindow.View = 2 For i = 1 To n ' ставим разрывы страниц If i Mod 6 = 0 Then Set Квиточки.HPageBreaks(i \ 6).Location = Квиточки.Cells(1 + [квиток].Rows.Count * (i \ 2), 1) Next End Sub
Sub ДобавитьКвитокНаЛист(ByRef sh As Worksheet, n As Long) With [квиток] Set МестоДляНовогоКвитка = sh.Cells(1 + .Rows.Count * (n \ 2), 1 + .Columns.Count * (n Mod 2)).Resize(.Rows.Count, .Columns.Count) .Copy МестоДляНовогоКвитка If n < 2 Then ' устанавливаем ширину столбцов For i = 1 To .Columns.Count МестоДляНовогоКвитка.Cells(i).EntireColumn.ColumnWidth = .Cells(i).EntireColumn.ColumnWidth Next i End If For i = 1 To .Rows.Count ' устанавливаем высоту строк МестоДляНовогоКвитка.Cells(i, 1).EntireRow.RowHeight = .Cells(i, 1).EntireRow.RowHeight Next i End With End Sub
Если откинуться от конкретики.. Создаем образ квиточка, имена полей создаем цикл переноса информации из строк исходной таблицы в образ оформляем код в событие _Change, т.к. данные динамические,а мы переносим значения Не знаю как сделать без _Change? Прилично, по отношению к ДВССЫЛ..! да и динамика в ДВССЫЛ.. присутствует где бы достать за так Уокенбаха по формулам в электронном виде.В Рапире у меня почему-то не скачивается Могу обменять он же по VBA 2002, Киммел Access 2002
> Прилично, по отношению к ДВССЫЛ..! да и динамика в ДВССЫЛ.. присутствует а мой вариант с формулами в таком случае чем не устроил? Там та ещё динамика... динамичнее не бывает
> при изменении таблицы обновлять чем? Нажатием одной кнопки, запускающей макрос
Предложение. В квитанциях прописать простые нелетучие форулы типа =ИНДЕКС(Форма_печать!$D$5:$D$35;$H$1*6-Х+1) где Х - номер квиточка (с 1 по 6 - количество квиточков на странице); $H$1 - порядковый номер печатаемого листа. бланк только на одной странице. Макрос в $H$1 добавляет единицу после каждого напечатаного листа и останавливает печать, если все квиточки напечатаны.
PS: Тема эта на форуме, конечно, старая, но мне на сайт отсюда идут люди, и не находят готовое решение (ибо поиск у меня на сайте плохо работает) Потому и решил опубликовать ссылку на решение здесь.