Копирование в буфер обмена.
Добавлено: 22 авг 2009, 18:28
Никто не в курсе, как с помощью VBA копировать в буфер обмена Office? Мне надо туда копировать колонтитулы, поэтому надо, чтобы было много скопировано, а не один элемент.
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Вот так можно скопировать в буфер обмена Office все верхние колонтитулы. Только при этом должен быть открыт Буфер обмена:
А никто не в курсе, как копировать только видимые колонтитулы? Т.е. каждый раздел имеет колонтитул первой страницы и основной колонтитул. Если раздел состоит из одной страницы, то мы видим лишь только один колонтитул: или колонтитул первой страницы или же основной колонтитул.
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Вот насочинял (только делается при открытом буфере обмена):
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Вот так можно скопировать в буфер обмена Office все верхние колонтитулы. Только при этом должен быть открыт Буфер обмена:
Код: Выделить всё
Sub CopyHeadersFooters()
Dim oSec As Section, oHeadr As HeaderFooter
For Each oSec In ActiveDocument.Sections
For Each oHeadr In oSec.Headers
oHeadr.Range.Copy
Next oHeadr
Next oSec
End Sub
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Вот насочинял (только делается при открытом буфере обмена):
Код: Выделить всё
Sub HeaderCopy()
On Error GoTo footercopy
Selection.HomeKey Unit:=wdStory
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Do
Selection.WholeStory
Selection.Copy
ActiveWindow.ActivePane.View.NextHeaderFooter
Loop
footercopy:
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Application.Run "footercopy"
End Sub
Sub footercopy()
On Error GoTo ExitSub
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Do
Selection.WholeStory
Selection.Copy
ActiveWindow.ActivePane.View.NextHeaderFooter
Loop
ExitSub:
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub