{quote}{login=demos_fobos}{date=18.01.2011 02:50}{thema=Re: Re: }{post}{quote}{login=demos_fobos}{date=18.01.2011 02:45}{thema=Re: }{post}{quote}{login=Казанский}{date=18.01.2011 12:22}{thema=}{post}Можно. Но печатать придется в цикле, по одной странице, каждый раз меняя колонтитул:  
 
Кстати, "п.1.6" и т.д. - это действительно имена диапазонов?  
В имени не может быть пробела: "п. 2.2"  
 
Private Sub Worksheet_Kolontit()  
Dim A, i As Long  
Application.EnableEvents = False  
A = Split("\п.1.6\п.2.2\Программа\Программа_2\перечень\Акт\Приказ\Письмо\Последний­_лист", "\")  
With ActiveSheet.PageSetup  
   For i = 1 To 9  
       .RightFooter = Range(A(i)).Value  
       ActiveSheet.PrintOut i, i  
   Next  
End With  
Application.EnableEvents = True  
End Sub{/post}{/quote}  
 
Ввел пустую переменную для первого листа, но теперь печатает только первый лист, а на редактирование шрифта совсем не реагирует проблемам во вложении.{/post}{/quote}{/post}{/quote}  
 
Тема закрыта все работает как нужно, просто проставил пустое значение для первого листа и проверил написание имен. Спасибо огромное Казанский.

{quote}{login=demos_fobos}{date=18.01.2011 02:45}{thema=Re: }{post}{quote}{login=Казанский}{date=18.01.2011 12:22}{thema=}{post}Можно. Но печатать придется в цикле, по одной странице, каждый раз меняя колонтитул:  
 
Кстати, "п.1.6" и т.д. - это действительно имена диапазонов?  
В имени не может быть пробела: "п. 2.2"  
 
Private Sub Worksheet_Kolontit()  
Dim A, i As Long  
Application.EnableEvents = False  
A = Split("\п.1.6\п.2.2\Программа\Программа_2\перечень\Акт\Приказ\Письмо\Последний­_лист", "\")  
With ActiveSheet.PageSetup  
   For i = 1 To 9  
       .RightFooter = Range(A(i)).Value  
       ActiveSheet.PrintOut i, i  
   Next  
End With  
Application.EnableEvents = True  
End Sub{/post}{/quote}  
 
Ввел пустую переменную для первого листа, но теперь печатает только первый лист, а на редактирование шрифта совсем не реагирует проблемам во вложении.{/post}{/quote}  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>

{quote}{login=Казанский}{date=18.01.2011 12:22}{thema=}{post}Можно. Но печатать придется в цикле, по одной странице, каждый раз меняя колонтитул:  
 
Кстати, "п.1.6" и т.д. - это действительно имена диапазонов?  
В имени не может быть пробела: "п. 2.2"  
 
Private Sub Worksheet_Kolontit()  
Dim A, i As Long  
Application.EnableEvents = False  
A = Split("\п.1.6\п.2.2\Программа\Программа_2\перечень\Акт\Приказ\Письмо\Последний­_лист", "\")  
With ActiveSheet.PageSetup  
   For i = 1 To 9  
       .RightFooter = Range(A(i)).Value  
       ActiveSheet.PrintOut i, i  
   Next  
End With  
Application.EnableEvents = True  
End Sub{/post}{/quote}  
 
Ввел пустую переменную для первого листа, но теперь печатает только первый лист, а на редактирование шрифта совсем не реагирует проблемам во вложении.

{quote}{login=Казанский}{date=18.01.2011 12:40}{thema=}{post}Запишите макрорекордером изменение формата так, как Вам нужно, и добавьте соотв. текст. Например:  
 
.RightFooter = "&""Arial,полужирный""&12" & Range(A(i)).Value{/post}{/quote}  
 
Спасибо работает как часы, Вы были правы проблема и именах была.

{quote}{login=Казанский}{date=18.01.2011 12:22}{thema=}{post}Можно. Но печатать придется в цикле, по одной странице, каждый раз меняя колонтитул:  
 
Кстати, "п.1.6" и т.д. - это действительно имена диапазонов?  
В имени не может быть пробела: "п. 2.2"  
 
Private Sub Worksheet_Kolontit()  
Dim A, i As Long  
Application.EnableEvents = False  
A = Split("\п.1.6\п.2.2\Программа\Программа_2\перечень\Акт\Приказ\Письмо\Последний­_лист", "\")  
With ActiveSheet.PageSetup  
   For i = 1 To 9  
       .RightFooter = Range(A(i)).Value  
       ActiveSheet.PrintOut i, i  
   Next  
End With  
Application.EnableEvents = True  
End Sub{/post}{/quote}  
 
 
Большое спасибо, если не трудно то подскажите как еще и форматирование текста сюда приписать (Шрифт,размер).

{quote}{login=Казанский}{date=18.01.2011 12:06}{thema=}{post}Вы не можете назначить колонтитул индивидуально для каждой страницы. "&P" заменяется на номер уже в процессе печати.  
 
Лучше расставьте разрывы страниц вручную и заполните соотв. ячейку на каждой странице.{/post}{/quote}  
А перед печатью можно вставить макрос замены?

{quote}{login=Казанский}{date=18.01.2011 11:44}{thema=}{post}У Вас  
.RightFooter = "&P"  
а потом Вы проверяете  
If .RightFooter = 1 ',2,3 и т.д. Конечно, ни одно условие не выполняется.  
 
Лучше словами опишите, что хотите сделать.{/post}{/quote}  
 
.RightFooter = "&P" как я понимаю данная функция прописывает номера страниц по порядку, мне же нужно что бы у первой страницы номер не проставлялся, у 2-ой страницы менялся на значение ячейки A, у 3-той на значение B и так далее пока не заменятся все проставленные колонтитулы. Если есть способ без замены буду при много благодарен

.RightFooter = "&P" как я понимаю данная функция прописывает номера страниц по порядку, мне же нужно что бы у первой страницы номер не проставлялся, у 2-ой страницы менялся на значение ячейки A, у 3-той на значение B и так далее пока не заменятся все проставленные колонтитулы. Если есть способ без замены буду при много благодарен.

День добрый, столкнулся с проблемой присвоения определенному колонтитулу определенного значения записанного в определенной ячейке непечатной области. Попробовал написать макрос, но знаний не хватило, приведенный ниже.  
 
 
Private Sub Worksheet_Kolontit()  
Dim A, B, C, D, E, F, G, H, I  
Application.EnableEvents = False  
With ActiveSheet.PageSetup  
A = Range("п.1.6").Value  
B = Range("п. 2.2").Value  
С = Range("Программа").Value  
D = Range("Программа_2").Value  
E = Range("перечень").Value  
F = Range("Акт").Value  
G = Range("Приказ").Value  
H = Range("Письмо").Value  
I = Range("Последний_лист").Value  
 
.RightFooter = "&P"  
 
If .RightFooter = 1 Then .RightFooter = ""  
 
If .RightFooter = 2 Then .RightFooter = A  
 
If .RightFooter = 3 Then .RightFooter = B  
 
If .RightFooter = 4 Then .RightFooter = C  
 
If .RightFooter = 5 Then .RightFooter = D  
 
If .RightFooter = 6 Then .RightFooter = E  
 
If .RightFooter = 7 Then .RightFooter = F  
 
If .RightFooter = 8 Then .RightFooter = G  
 
If .RightFooter = 9 Then .RightFooter = H  
 
If .RightFooter = 10 Then .RightFooter = I  
End With  
Application.EnableEvents = True  
End Sub  
 
Помогите разобраться.

{quote}{login=ZVI}{date=23.03.2008 11:49}{thema=Re: сжатие пробелов в VBA}{post}{quote}{login=}{date=23.03.2008 10:49}{thema=}{post}Кто-нибудь помогите!{/post}{/quote}  
---  
Света, вот такой макрос поможет:  
 
' Удаление крайних и двойных пробелов  
Sub TrimSpaces()  
Dim v As Range  
For Each v In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)  
v.Value = Trim(v)  
While InStr(1, v, "  ", vbTextCompare) > 0  
v.Value = Replace(v, "  ", " ")  
Wend  
Next  
End Sub  
 
--  
ZVI{/post}{/quote}  
а подскажите как сделать что бы данный макрос запускался автоматически при вводе данных в определенную область?

{quote}{login=MCH}{date=23.09.2010 05:00}{thema=Re: Нумерация по дате с оригинальным номером}{post}{quote}{login=demos_fobos}{date=23.09.2010 04:04}{thema=Нумерация по дате с оригинальным номером}{post} Пример в приложении.{/post}{/quote}  
 
В примере Вы не указали, а какие именно нужно присвоить номера?  
вакладываю свое понимание{/post}{/quote}  
 
Спасибо все заработало так как нужно

Здравствуйте, подскажите как пронумеровать список состоящий из списка повторяющихся дат, присваивая номер начиная с минимальной даты к максимальной, по порядку внутри повторяющихся значений дат и продолжить нумерацию на следующую дату по возрастанию. Номера должны быть оригинальными. Пример в приложении.