Copying a table to a header

[Tarjei T. Jensen]

Can sombody point me to some documentation which explains how to copy a
table to a header?

I have tried searching in google, but the search is swamped by people
copying a single cell. I know how to do that. I want to copy the entire
table.


Suggestions?

 

[Helmut Weber]

Hi Tarjei,
it is not that difficult, unless you have to deal with different
storyranges, that have different headers.
Under quite ordinary border conditions:
Dim r As Range
Dim d As Document
Set d = ActiveDocument
Set r = d.Tables(1).Range ' get table 1
r.Copy ' make a copy
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' creates a header in case there was none
d.StoryRanges(wdPrimaryHeaderStory).Paste
' replace all in the header by a copy of table 1
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
' close the header window (the active pane) and return
---
Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr$(64) & "t-online.de"




Gruss
Helmut Weber
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98

 

[Tarjei T. Jensen]

it is not that difficult, unless you have to deal with different
storyranges, that have different headers.
Under quite ordinary border conditions:
Dim r As Range
Dim d As Document
Set d = ActiveDocument
Set r = d.Tables(1).Range ' get table 1
r.Copy ' make a copy
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' creates a header in case there was none
d.StoryRanges(wdPrimaryHeaderStory).Paste
' replace all in the header by a copy of table 1
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
' close the header window (the active pane) and return

This solution clobbers the clipboard. I'm trying to avoid that. I want do do
as little damage to the user environment as possible.

As of now, it would be better to create the table in VBA and then populate
it by copying the original table cell by cell.


Any other suggestions?


greetings,

 

[Helmut Weber]

Hi Tarjei,
one other, very simple way would be, to define
an autotext entry on the basis of the table,
to insert the table from autotext then,
and possibly remove the autotext entry afterwards.
I don't think you will need a code example for that.
Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr(64) & "t-online.de"
Word XP, Windows 2000

 

[Tarjei T. Jensen]

one other, very simple way would be, to define
an autotext entry on the basis of the table,
to insert the table from autotext then,
and possibly remove the autotext entry afterwards.
I don't think you will need a code example for that.

That is probably correct. The problem is that I'm not (yet) comfortable with
autotext.

As of now, I just re-create the table and copy the elements. As shown below.
This is a solution I'm comfortable with. Word might not be comfortable with
it. On the first "working" attempt it crashed. Same on second attempt. Now
I'm worried.

BTW I quit word after every test, so there is little chance that accumulated
errors will unsettle word.

----- code -----

Private Sub Set_letter_header2()
Dim from_rng As Range
Dim to_rng As Range
Dim to_table As Table
Dim from_table As Table
Dim rowC As Integer
Dim colC As Integer


Debug.Print "enter set_letter_header2"
Set from_table = infoDoc.Tables(4)

Set from_rng =
ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range

With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
.Range.FormattedText = from_rng.FormattedText
.Range.ParagraphFormat.LeftIndent = MillimetersToPoints(-15)
.Range.InsertAfter vbCrLf
Debug.Print "5"
set to_rng = .Range
to_rng.Start = to_rng.End
rowC = from_table.Rows.Count
colC = from_table.Columns.Count
to_rng.Tables.Add to_rng, rowC, colC
Debug.Print "6"
'.LinkToPrevious = False
Set to_table = to_rng.Tables(1)
For rowC = 1 To from_table.Rows.Count
For colC = 1 To from_table.Columns.Count
to_table.Cell(rowC, colC).Range.FormattedText =
from_table.Cell(rowC, colC).Range.FormattedText
Next colC
Next rowC
End With

Debug.Print "exit set_letter_header2"
End Sub

 

[Helmut Weber]

Hi Tarjei,
one more idea, that may need some refinement, too:
' wdHeaderFooterPrimary = 1 '.headers
Dim d As Document
Dim r As Range
Dim t As Table
Set d = ActiveDocument
Set t = d.Tables(1)
Set r = d.Sections(1).Headers(1).Range
NormalTemplate.AutoTextEntries.Add _
Name:="tab03", Range:=t.Range
NormalTemplate.AutoTextEntries("tab03").Insert _
Where:=r, _
RichText:=True
(I like it short)
Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr(64) & "t-online.de"
Word XP, Windows 2000

 

[Tarjei T. Jensen]

one more idea, that may need some refinement, too:
' wdHeaderFooterPrimary = 1 '.headers
Dim d As Document
Dim r As Range
Dim t As Table
Set d = ActiveDocument
Set t = d.Tables(1)
Set r = d.Sections(1).Headers(1).Range
NormalTemplate.AutoTextEntries.Add _
Name:="tab03", Range:=t.Range
NormalTemplate.AutoTextEntries("tab03").Insert _
Where:=r, _
RichText:=True

That is fine, sort of. There are two problems. 1. Normal.dot is not
writeable at our site. 2. My template is an add-in and will probably not be
writeable.

I thought this would be simple. Sigh :-(

greetings,

 

[Doug Robbins - Word MVP]

Use

Dim myrange As Range
Set myrange = ActiveDocument.Tables(1).Range.FormattedText
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.FormattedText
= myrange


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[Tarjei T. Jensen]

Dim myrange As Range
Set myrange = ActiveDocument.Tables(1).Range.FormattedText
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.FormattedTex
t
= myrange

That was spot on. Thanks a lot.

I thought I had tried that before I asked for help, but somehow I screwed
up.

Greetings,

In case anybody is interested the procedure is shown below.
The procedure does the following.
1. copies the first page header to the primary header.
2. shifts this 15mm to the left
3. Inserts a newline
4. copies an array into the primary header.
It will be populated at a later date when I've found some docs on fields
and formfields.


Private Sub Set_letter_header2()
Dim from_header_rng As Range
Dim from_table_rng As Range
Dim to_rng As Range

Debug.Print "enter set_letter_header2"
Set from_table_rng = infoDoc.Tables(4).Range
Set from_header_rng =
ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range

With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
.Range.FormattedText = from_header_rng.FormattedText
.Range.ParagraphFormat.LeftIndent = MillimetersToPoints(-15)
.Range.InsertAfter vbCrLf
Set to_rng = .Range
'.LinkToPrevious = False
End With

to_rng.Collapse wdCollapseEnd
to_rng.FormattedText = from_table_rng.FormattedText

Debug.Print "exit set_letter_header2"
End Sub