lightyear
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Добрый день
С наступающими праздниками 
В связи с этими самыми праздниками передо мной возникла небольшая задачка, нужно отослать массу поздравлений (200 шт.)
Естественно, их очень не хотелось верстать руками, учитывая, что они достаточно однотипны, возникла мысль сделать список, по которому все это и сгенерить и выкинуть в Ворд, 1 поздравление - 1 страница, напечатать и вперед
+ это же решение чудно подойдет не только на Пасху), но и к любому другому празднику, когда нужны массовые поздравления.
Пользователь - секретарь, умеет что-от набить в Excel и запустить макрос .
VBA вообще пользуюсь от случая к случаю, но на этот раз он выглядел самым подходящим решением вопроса
Хочу сказать спасибо Вашему форуму, Вы дали мне направление поиска, а дальше все было легко
Все сделано элементарно в одной к книге, к которой макрос и прикреплен, никаких передаваемых или настраиваемых параметров не делалось, ибо на скорую руку
Устройство книги
В книге два листа
Список
Столбец А - № п/п - для макроса вообще говоря не надо, но для списка пригодиться
Столбец В - Фамилия
Столбец С - Имя Отчество (для украинского языка сразу в кличному відмінку, напр. Олено Миколаївно)
Столбец D - Пол (ж/м)
Столбец Е - Признак включения в список поздравляемых (0/1)
Остальные столбцы произвольны (наши товарищи их приспособили под фирмы и адреса)
Поздравление
Ячейка А1 - текст поздравления (многостроное набирается через Alt+Enter)
Ячейка B1 - обращение к мужчине (Дорогой/Любимый/Родной)
Ячейка C1 - обращение к женщине (Дорогая/Любимая/Родная)
Ячейка D1 - регалии (С уважением, большой начальник)
Ячейка E1 - посылатель поздравления (ФИО большого начальника)
И сам макрос, который по книге указанной структуры, выборочно для товарищей у кого в признаке поздравления стоит 1, генерит поздравления в ворд по ходу форматируя
Код:
Dim i As Integer
Dim g As String
Dim s As String
Dim s1 As String
Dim female As String
Dim male As String
Dim result As String
Dim wrd As Variant
Dim myRange As Variant
Worksheets("Поздравление").Activate
g = Range("A1").Value
male = Range("B1").Value
female = Range("C1").Value
s = Range("D1").Value
s1 = Range("E1").Value
Set wrd = GetObject(, "Word.Application")
wrd.Visible = True
wrd.Documents.Add
Set myRange = wrd.Selection
myRange.Font.Size = "16"
myRange.Font.Name = "Times New Roman"
myRange.Font.Italic = True
Worksheets("Список").Activate
For i = 1 To 1000 Step 1
result = ""
If Range("C" & i).Value = "" Then 'list ends
Exit For
End If
If Range("E" & i).Value = 1 Then 'include this record
If Range("D" & i).Value = "m" Then 'is man?
result = result & male
Else
result = result & female
End If
result = result & " " & Range("C" & i) & "!"
myRange.ParagraphFormat.Alignment = 1 'center
myRange.Font.Bold = True
myRange.TypeText result
myRange.TypeParagraph
myRange.TypeParagraph
myRange.ParagraphFormat.Alignment = 1 'center
myRange.Font.Bold = False
myRange.TypeText g
myRange.TypeParagraph
myRange.TypeParagraph
myRange.ParagraphFormat.Alignment = 0 'left
myRange.Font.Size = "14"
myRange.Font.Bold = True
myRange.TypeText s
myRange.TypeParagraph
myRange.TypeParagraph
myRange.ParagraphFormat.Alignment = 2 'right
myRange.TypeText s1
'break new page
myRange.InsertBreak Type:=7
End If
Next
Set wrd = Nothing
End Sub
|
! Периодически возникает проблема с созданием объекта Word, решается просто пользовательсикм запуском Word, в смысле если Word уже запущен макрос в Excel отрабатывает без проблем
Может кому-то пригодиться в качестве "рыбы" или при решении сходных задач
|
Всего записей: 1 | Зарегистр. 24-04-2008 | Отправлено: 19:32 24-04-2008 | Исправлено: lightyear, 19:43 24-04-2008 |
|
Excel задумывается, прибор щёлкает, работает.
).