Problems setting HeadingFormat

tfurnivall · #1 04-07-2014, 12:47 PM

Disclaimer - also posted to another forum, but this seems to have better tools!

I am creating two documents from a PowerPoint script (GenScript) - a Recording Script and a Shooting Script. Other than the number of columns, the Recording Script and Shooting Script are constructed in identical manner. This description concentrates on the Recording script, which is simpler in design.

This procedure works by going through the Notes pages of a PowerPoint presentation, and creating a document with four columns (Slide#, Text, Time and Comments). The Notes text from each slide goes in the Text column - the Slide number goes in (surprisingly enough) the Slide # column, and the other two are used to capture timings and other comments.

I have a header row, with different formatting, and want this header row to appear at the top of each page. Here is the procedure that I use to Initiate each script:

Code:

Sub InitiateScript(ThisScript As Word.Document, ScriptType As String)

'   NOTE This procedure uses word functions (InchesToPoints), which MUST be qualified with
'   the instance of word that is being referenced. If not, then the code will not repeat.
'   (Comment from Micro$oft: This bahavior is by design) !?
'   http://support.microsoft.com/kb/189618

Dim ColWidths(SNotesCol) As Single

Dim TableHeaderText As String
Dim TableRange As Range
Dim TableCount As Long
Dim OldWidth As Single
Dim NewWidth As Single
Dim ScriptTable As Word.Table

'   External variables exist for RecordScriptTable &
'   ShootingScriptTable - used in many of the procedures

'   Set up the basic skeleton of the script document
CreateScriptCoverPage ThisScript, ScriptType
CreateScriptHeaders ThisScript, ScriptType
CreateScriptTableOfContents ThisScript, ScriptType

'   Set up a range comprising the whole (empty) document
TableHeaderText = ""
Set TableRange = ThisScript.Range
TableRange.Collapse Direction:=wdCollapseEnd
TableRange.InsertAfter Text:=TableHeaderText

'   Create a table with the right number of columns
TableCount = ThisScript.Tables.Count
If ScriptType = "Recording" Then
   Set RecordingScriptTable = ThisScript.Tables.Add(TableRange, ScriptTableInitialRows, RecordingScriptNumColumns)
   Set ScriptTable = RecordingScriptTable
ElseIf ScriptType = "Shooting" Then
   Set ShootingScriptTable = ThisScript.Tables.Add(TableRange, ScriptTableInitialRows, ShootingScriptNumColumns)
   Set ScriptTable = ShootingScriptTable
End If

If ScriptType = "Recording" Then
   With ScriptTable.Range
        .Cells(RSlideCol).Range.InsertBefore Text:="Slide #"
        .Cells(RTextCol).Range.InsertBefore Text:="Script"
        .Cells(RTimeCol).Range.InsertBefore Text:="Time"
        .Cells(RNotesCol).Range.InsertBefore Text:="Comments"
   End With
ElseIf ScriptType = "Shooting" Then
   With ScriptTable.Range
        .Cells(SSlideCol).Range.InsertBefore Text:="Slide #"
        .Cells(SAnimationCol).Range.InsertBefore Text:="Animation #"
        .Cells(STimeCol).Range.InsertBefore Text:="Time"
        .Cells(STitleCol).Range.InsertBefore Text:="Slide Title"
        .Cells(STextCol).Range.InsertBefore Text:="Script"
        .Cells(SFXCol).Range.InsertBefore Text:="FX"
        .Cells(SNotesCol).Range.InsertBefore Text:="Comments"
   End With
End If

'   Set column widths
ScriptTable.PreferredWidthType = wdPreferredWidthAuto

'   Columns for Recording Script
If ScriptType = "Recording" Then
   ScriptTable.Columns(RSlideCol).Width = WordApp.InchesToPoints(0.75)
   ScriptTable.Columns(RSlideCol).Select
   WordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

   ScriptTable.Columns(RTextCol).Width = WordApp.InchesToPoints(6.5)
   
   ScriptTable.Columns(RTimeCol).Width = WordApp.InchesToPoints(1#)
   ScriptTable.Columns(RTimeCol).Select
   WordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

   ScriptTable.Columns(RNotesCol).Width = WordApp.InchesToPoints(2#)
End If

'   Columns for Shooting Script
If ScriptType = "Shooting" Then
   ScriptTable.Columns(SSlideCol).Width = WordApp.InchesToPoints(0.5)
   ScriptTable.Columns(SSlideCol).Select
   WordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

   ScriptTable.Columns(STitleCol).Width = WordApp.InchesToPoints(1)

   ScriptTable.Columns(SAnimationCol).Width = WordApp.InchesToPoints(0.5)
   ScriptTable.Columns(SAnimationCol).Select
   WordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

   ScriptTable.Columns(STimeCol).Width = WordApp.InchesToPoints(0.5)
   ScriptTable.Columns(STimeCol).Select
   WordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

   ScriptTable.Columns(STextCol).Width = WordApp.InchesToPoints(4)
   ScriptTable.Columns(SFXCol).Width = WordApp.InchesToPoints(1.5)
   ScriptTable.Columns(SNotesCol).Width = WordApp.InchesToPoints(1.5)
End If

'   Adjust the first row
With ScriptTable.Rows(1)
    .Shading.Texture = wdTextureNone
    .Shading.ForegroundPatternColor = wdColorAutomatic
    .Shading.BackgroundPatternColor = wdBlack
    .Range.Font.Name = "Albertus MT"
    .Range.Font.Size = 10
End With

ScriptTable.Rows(1).HeadingFormat = True

With ScriptTable.Borders
    .OutsideLineStyle = wdLineStyleSingle
    .OutsideColor = wdColorBlack
    .OutsideLineWidth = wdLineWidth100pt
    .InsideLineStyle = wdLineStyleSingle
    .InsideColor = wdColorBlack
    .InsideLineWidth = wdLineWidth100pt
End With

End Sub

I've also attached a Recording Script that was created by this procedure. As you can see the "Repeat as Header Row at top of each Page" is checked. However, it doesn't actually do what it's supposed to

I had a response on the other forum from a couple of people - thanks. But I couldn't figure out how to attach code or files. Hence this second, duplicative posting.

Any ideas?

Thanks,

Tony

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Problems setting up email accounts.	macc2014	Outlook	0	02-18-2014 12:36 PM
work of labor vs work of excavator	ketanco	Project	1	02-11-2014 08:53 AM
work vs regular work. and how regular work works	user0044	Project	5	03-06-2012 07:28 AM
Making the IF field work (not Mail Merge)	Caroline	Mail Merge	5	04-11-2011 04:17 PM
Work Offline Setting	thomas34461	Outlook	1	04-04-2011 01:42 PM