AutOpen Macro not working

B

Bill Bowes

I have an AutoOpen Macro which is supposed to populate the header and footer
with document file details. (the code is below).

The problem is, that when it runs, even through the VBA stepthrough (f8), it
jumps past the section 6 which tells it to open the header, and it puts all
the data in the body of the document so wiping out the body text that is
already there.

I am running Word 2002.

I have looked at the normal.dot to see if there is anything to stop this
running properly but there is nothing I can see that would stop it partially
working.

HELP!!!

The QWCS.ini file is a text file created from my other application.

Sub MAIN()


'Section1 - This specificies the dimensions for all possible QWCS.INI
[Document]entries

Dim Approver As String
Dim ApprovalDate As String
Dim Author As String
Dim Category As String
Dim CRQNo As String
Dim DateCreate As String
Dim Database As String
Dim DateEdit As String
Dim DateIssued As String
Dim DateMod As String
Dim Dept As String
Dim DocPath As String
Dim DocOwner As String
Dim DocRef As String
Dim DocType As String
Dim Edit As String
Dim Editor As String
Dim Issued As String
Dim NewDoc As String
Dim Revision As String
Dim RevisionOld As String
Dim SerNo As String
Dim Security As String
Dim Status As String
Dim StatNum As String
Dim Title As String
Dim UserID As String
Dim UserName As String

'Section2 - This section extracts the values for all QWCS.INI [Document]
entries and assigns them to the Dimensions specified above

Approver = System.PrivateProfileString("qwcs.ini", "Document", "QWAPPR")
ApprovalDate = System.PrivateProfileString("qwcs.ini", "Document", "QWADATE")
Author = System.PrivateProfileString("qwcs.ini", "Document", "QWAUTHOR")
Category = System.PrivateProfileString("qwcs.ini", "Document", "QWCATEGORY")
CRQNo = System.PrivateProfileString("qwcs.ini", "Document", "QWCRQ")
DateCreate = System.PrivateProfileString("qwcs.ini", "Document", "QWCDATE")
Database = System.PrivateProfileString("qwcs.ini", "Document", "DOCDATA")
DateIssued = System.PrivateProfileString("qwcs.ini", "Document", "QWISSUE")
DateMod = System.PrivateProfileString("qwcs.ini", "Document", "QWMDATE")
Dept = System.PrivateProfileString("qwcs.ini", "Document", "QWDEPARTMENT")
DocPath = System.PrivateProfileString("qwcs.ini", "Document", "QWDOCPATH")
DocOwner = System.PrivateProfileString("qwcs.ini", "Document", "QWOWNER")
DocRef = System.PrivateProfileString("qwcs.ini", "Document", "QWREF")
DocType = System.PrivateProfileString("qwcs.ini", "Document", "QWTYPE")
Edit = System.PrivateProfileString("qwcs.ini", "Document", "QWEDIT")
Editor = System.PrivateProfileString("qwcs.ini", "Document", "QWEDITOR")
Issued = System.PrivateProfileString("qwcs.ini", "Document", "QWISSUED")
NewDoc = System.PrivateProfileString("qwcs.ini", "Document", "QWNEW")
Revision = System.PrivateProfileString("qwcs.ini", "Document", "QWREV")
RevisionOld = System.PrivateProfileString("qwcs.ini", "Document", "QWREVOLD")
Security = System.PrivateProfileString("qwcs.ini", "Document", "QWSEC")
SerNo = System.PrivateProfileString("qwcs.ini", "Document", "QWSERIAL")
Stat = System.PrivateProfileString("qwcs.ini", "Document", "QWSTAT")
StatNum = System.PrivateProfileString("qwcs.ini", "Document", "QWSTATNUM")
Title = System.PrivateProfileString("qwcs.ini", "Document", "QWTITLE")
UserID = System.PrivateProfileString("qwcs.ini", "Document", "QWUSERID")
UserName = System.PrivateProfileString("qwcs.ini", "Document", "QWUSER")

'Section3 - Options to disable based on UserId
'This section enables all the options based on specified UserID
If UserID = "admin" Or UserID = "id1" Or UserID = "id2" Then

On Error Resume Next
CustomizationContext = ActiveDocument
CommandBars("Standard").Controls("Save").Enabled = True 'Enables the Save
option
CommandBars("Standard").Controls("Print").Enabled = True 'Enables The Print
option
CommandBars("Standard").Controls("Print Preview").Enabled = True 'Enables
The Print Preview option
CommandBars("Standard").Controls("Cut").Enabled = True 'Enables The Cut option
CommandBars("Standard").Controls("Copy").Enabled = True 'Enables The Copy
option
CommandBars("File").Controls("Save").Enabled = True 'Enables the Save option
CommandBars("File").Controls("Save As...").Enabled = True 'Enables the Save
As option
CommandBars("File").Controls("Save As HTML...").Enabled = True 'Enables the
Save As HTML option
CommandBars("File").Controls("Print...").Enabled = True 'Enables the Print
option
CommandBars("File").Controls("Print Preview").Enabled = True 'Enables the
Print Preview option
CommandBars("Edit").Controls("Cut").Enabled = True 'Enables the Cut option
CommandBars("Edit").Controls("Copy").Enabled = True 'Enables the Copy option
CommandBars("Tools").Controls("Customize...").Enabled = True 'Enables the
Customise option
KeyBindings.Add KeyCode:=wdKeyF12, KeyCategory:=wdKeyCategoryCommand,
Command:="FilePrint" 'Enables the F12 keyboard shortcut for printing
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeyP),
KeyCategory:=wdKeyCategoryCommand, Command:="FilePrint" 'Enables the Ctrl+P
keyboard shortcut for printing
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeyS),
KeyCategory:=wdKeyCategoryCommand, Command:="FileSave" 'Enables the Ctrl+S
keyboard shortcut for saving
GoTo InsertInfo

'This section disables all the options based on specified UserID
Else
On Error Resume Next
CustomizationContext = ActiveDocument
CommandBars("Standard").Controls("Save").Enabled = False 'Disables the Save
option
CommandBars("Standard").Controls("Print").Enabled = False 'Disables The
Print option
CommandBars("Standard").Controls("Print Preview").Enabled = False 'Disables
The Print Preview option
CommandBars("Standard").Controls("Cut").Enabled = False 'Disables The Cut
option
CommandBars("Standard").Controls("Copy").Enabled = False 'Disables The Copy
option
CommandBars("File").Controls("Save").Enabled = False 'Disables the Save option
CommandBars("File").Controls("Save As...").Enabled = False 'Disables the
Save As option
CommandBars("File").Controls("Save As HTML...").Enabled = False 'Disables
the Save As HTML option
CommandBars("File").Controls("Print...").Enabled = False 'Disables the Print
option
CommandBars("File").Controls("Print Preview").Enabled = False 'Disables the
Print Preview option
CommandBars("Edit").Controls("Cut").Enabled = False 'Disables the Cut option
CommandBars("Edit").Controls("Copy").Enabled = False 'Disables the Copy option
CommandBars("Tools").Controls("Customize...").Enabled = False 'Disables the
Customise option
FindKey(KeyCode:=wdKeyF12).Disable 'Enables the F12 keyboard shortcut for
printing
FindKey(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyS)).Disable 'Disables the
Ctrl+P keyboard shortcut for printing
FindKey(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyP)).Disable 'Disables the
Ctrl+S keyboard shortcut for saving
FindKey(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyC)).Disable 'Disables the
Ctrl+S keyboard shortcut for Copy
FindKey(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyX)).Disable 'Disables the
Ctrl+S keyboard shortcut for Cut
GoTo InsertInfo
End If

'Section4 - Determine the Absolute Document Status.

InsertInfo:
Select Case StatNum
Case "0"
Status = "New Draft "
Case "1"
Status = "New Draft, Ready for Approval "
Case "2"
Status = "New Draft, Undergoing Approval "
Case "3"
Status = "New Draft, Awaiting Issue "
Case "4"
Status = "Issued "
Case "5"
Status = "Issued, New Draft Exists "
Case "6"
Status = "Issued, New Draft Ready for Approval "
Case "7"
Status = "Issued, New Draft Undergoing Approval"
Case "8"
Status = "Issued, New Draft Awaiting Issue "
Case "9"
Status = "Obsolete "
Case "10"
Status = "Superseded "
Case "11"
Status = "Awaiting Withdrawal "
Case Else
Status = "Unknown "
End Select

'Section5 - Determine if you are viewing the ISSUED or DRAFT

Select Case Issued
Case "10"
Issued = "You are viewing the ISSUED version"
Case "11"
Issued = "You are viewing the DRAFT version"
Case "20"
Issued = "You are viewing the ISSUED version"
Case "21"
Issued = "You are viewing the DRAFT version"
End Select

'Section6 - This section creates the header, clears it then inserts all
the QWCS.INI Document info into it

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Or
ActiveWindow.ActivePane.View.Type _
= wdMasterView Then
ActiveWindow.ActivePane.View.Type = wdPageView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.WholeStory
Selection.Delete
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 8
Selection.Font.Underline = False
Selection.TypeText Text:="Last Approver: " + Approver + Chr(9) + Chr(9)
+ "Date of Approval: " + ApprovalDate
Selection.TypeParagraph
Selection.TypeText Text:="Document Author: " + Author + Chr$(9) + Chr(9)
+ "Category: " + Category
Selection.TypeParagraph
Selection.TypeText Text:="CRQ Number: " + CRQNo + Chr(9) + Chr(9) +
"Date Created: " + DateCreate
Selection.TypeParagraph
Selection.TypeText Text:="Database: " + Database + Chr(9) + Chr(9) +
"Date Issued: " + DateIssued
Selection.TypeParagraph
Selection.TypeText Text:="Date Modified: " + DateCreate + Chr(9) +
Chr(9) + "Department: " + Dept
Selection.TypeParagraph
Selection.TypeText Text:="Document Owner: " + DocOwner + Chr(9) + Chr(9)
+ "Path: " + DocPath
Selection.TypeParagraph
Selection.TypeText Text:="Reference: " + DocRef + Chr(9) + Chr(9) +
"Type: " + DocType
Selection.TypeParagraph
Selection.TypeText Text:="Edit Mode: " + Edit + Chr(9) + Chr(9) +
"Editor: " + Editor
Selection.TypeParagraph
Selection.TypeText Text:="New Document?: " + NewDoc + Chr(9) + Chr(9) +
"Version Viewed : " + Issued
Selection.TypeParagraph
Selection.TypeText Text:="Revision Number: " + Revision + Chr(9) +
Chr(9) + "Previous Revision: " + RevisionOld
Selection.TypeParagraph
Selection.TypeText Text:="Security: " + Security + Chr(9) + Chr(9) +
"serial Number: " + SerNo
Selection.TypeParagraph
Selection.TypeText Text:="Status: " + Stat + Chr(9) + Chr(9) + "Full
Status: " + Status
Selection.TypeParagraph
Selection.TypeText Text:="Document Title: " + Title + Chr(9) + Chr(9) +
"ID of User Viewing: " + UserID
Selection.TypeParagraph
Selection.TypeText Text:="Name of User Viewing: " + UserName
Selection.TypeParagraph

'Section7 This section clears then inserts the Footer information

If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
Selection.WholeStory
Selection.Delete
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 8
Selection.Font.Underline = False
Selection.TypeText Text:="Date Printed: " + Date$ + Chr(9) + Chr(9) +
"Page: "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"NUMPAGES "
Selection.TypeParagraph
Selection.TypeText Text:="This Document is controlled using Workbench
Professional"
Selection.TypeParagraph


'Section8 This Section moves the focus back to the main Document, clears
it and and inserts the title

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.MoveUp
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Font.Name = "Arial Narrow"
Selection.Font.Size = 14
Selection.Font.Bold = True
Selection.Font.Underline = True
Selection.TypeText Text:=Title
Selection.Font.Bold = False
Selection.Font.Underline = False
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10

'Section9 Inserts an 'Uncontrolled when printed' watermark

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Or
ActiveWindow.ActivePane.View.Type _
= wdMasterView Then
ActiveWindow.ActivePane.View.Type = wdPageView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
ActiveWindow.ActivePane.View.ShowMainTextLayer = Not ActiveWindow. _
ActivePane.View.ShowMainTextLayer
Selection.HeaderFooter.Shapes.AddTextbox(msoTextOrientationHorizontal, _
100.8, 295.2, 410.4, 86.4).Select
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.TextFrame.TextRange.Select
Selection.Collapse
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 32
Selection.Font.Underline = False
Selection.Font.ColorIndex = wdGray25
Selection.TypeText Text:="UNCONTROLLED WHEN PRINTED"
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub
 
C

Charles Kenyon

First, I don't think you want this all as an AutoOpen macro. Consider
setting up a template that has the header you want with dynamic fields and
custom document property fields. Write an AutoNew macro to populate the
custom document properties. Then, when you create a new document from your
template, your fields will be updated with current information but the
information will not be subject to being altered every time someone opens
the document.

You can find information about each stage of this at
http://word.mvps.org/FAQs/MacrosVBA.htm.

If you need to actually insert your header information using code, use the
range object.
The following code is provided merely by way of example. It uses the range
in a header/footer context but is incomplete in that it uses other
functions/subs to work.

Private Sub ReplaceHeaders(sTemplateName As String)
' Altered to delete stories 8 October 2005

' Replaces Header and FirstPageHeader with contents from
' base template
' Replaces Footer and FirstPageFooter with contents from
' base template
' Assumes that bookmarks have been preserved in base and copies.
' Otherwise will generate error
' Required bookmarks are "Footer1," "Footer2," "Header1," and
"Header2"
'
Dim rRange As Range
Dim sFooter As String
Dim sHeader As String
'
' First Page Header
Set rRange = ActiveDocument.StoryRanges(wdFirstPageHeaderStory)
rRange.Delete
rRange.InsertFile FileName:=WorkGroupPath _
& "Letters & Faxes\" & sTemplateName, _
Range:="Header1", _
ConfirmConversions:=False, Attachment:=False, Link:=False
' Continuation Header
Set rRange = ActiveDocument.StoryRanges(wdPrimaryHeaderStory)
rRange.Delete
rRange.Style = ActiveDocument.Styles("Header 3")
rRange.InsertFile FileName:=WorkGroupPath _
& "Letters & Faxes\" & sTemplateName, _
Range:="Header2", _
ConfirmConversions:=False, Attachment:=False, Link:=False
' First Page Footer
Set rRange = ActiveDocument.StoryRanges(wdFirstPageFooterStory)
rRange.Delete
rRange.InsertFile FileName:=WorkGroupPath _
& "Letters & Faxes\" & sTemplateName, _
Range:="Footer1", _
ConfirmConversions:=False, Attachment:=False, Link:=False
' Continuation Footer
Set rRange = ActiveDocument.StoryRanges(wdPrimaryFooterStory)
rRange.Delete
rRange.InsertFile FileName:=WorkGroupPath _
& "Letters & Faxes\" & sTemplateName, _
Range:="Footer2", _
ConfirmConversions:=False, Attachment:=False, Link:=False
End Sub

Hope this helps more than it confuses.
--
Charles Kenyon

Word New User FAQ & Web Directory: http://addbalance.com/word

Intermediate User's Guide to Microsoft Word (supplemented version of
Microsoft's Legal Users' Guide) http://addbalance.com/usersguide


--------- --------- --------- --------- --------- ---------
This message is posted to a newsgroup. Please post replies
and questions to the newsgroup so that others can learn
from my ignorance and your wisdom.

Bill Bowes said:
I have an AutoOpen Macro which is supposed to populate the header and
footer
with document file details. (the code is below).

The problem is, that when it runs, even through the VBA stepthrough (f8),
it
jumps past the section 6 which tells it to open the header, and it puts
all
the data in the body of the document so wiping out the body text that is
already there.

I am running Word 2002.

I have looked at the normal.dot to see if there is anything to stop this
running properly but there is nothing I can see that would stop it
partially
working.

HELP!!!

The QWCS.ini file is a text file created from my other application.

Sub MAIN()


'Section1 - This specificies the dimensions for all possible QWCS.INI
[Document]entries

Dim Approver As String
Dim ApprovalDate As String
Dim Author As String
Dim Category As String
Dim CRQNo As String
Dim DateCreate As String
Dim Database As String
Dim DateEdit As String
Dim DateIssued As String
Dim DateMod As String
Dim Dept As String
Dim DocPath As String
Dim DocOwner As String
Dim DocRef As String
Dim DocType As String
Dim Edit As String
Dim Editor As String
Dim Issued As String
Dim NewDoc As String
Dim Revision As String
Dim RevisionOld As String
Dim SerNo As String
Dim Security As String
Dim Status As String
Dim StatNum As String
Dim Title As String
Dim UserID As String
Dim UserName As String

'Section2 - This section extracts the values for all QWCS.INI [Document]
entries and assigns them to the Dimensions specified above

Approver = System.PrivateProfileString("qwcs.ini", "Document", "QWAPPR")
ApprovalDate = System.PrivateProfileString("qwcs.ini", "Document",
"QWADATE")
Author = System.PrivateProfileString("qwcs.ini", "Document", "QWAUTHOR")
Category = System.PrivateProfileString("qwcs.ini", "Document",
"QWCATEGORY")
CRQNo = System.PrivateProfileString("qwcs.ini", "Document", "QWCRQ")
DateCreate = System.PrivateProfileString("qwcs.ini", "Document",
"QWCDATE")
Database = System.PrivateProfileString("qwcs.ini", "Document", "DOCDATA")
DateIssued = System.PrivateProfileString("qwcs.ini", "Document",
"QWISSUE")
DateMod = System.PrivateProfileString("qwcs.ini", "Document", "QWMDATE")
Dept = System.PrivateProfileString("qwcs.ini", "Document", "QWDEPARTMENT")
DocPath = System.PrivateProfileString("qwcs.ini", "Document", "QWDOCPATH")
DocOwner = System.PrivateProfileString("qwcs.ini", "Document", "QWOWNER")
DocRef = System.PrivateProfileString("qwcs.ini", "Document", "QWREF")
DocType = System.PrivateProfileString("qwcs.ini", "Document", "QWTYPE")
Edit = System.PrivateProfileString("qwcs.ini", "Document", "QWEDIT")
Editor = System.PrivateProfileString("qwcs.ini", "Document", "QWEDITOR")
Issued = System.PrivateProfileString("qwcs.ini", "Document", "QWISSUED")
NewDoc = System.PrivateProfileString("qwcs.ini", "Document", "QWNEW")
Revision = System.PrivateProfileString("qwcs.ini", "Document", "QWREV")
RevisionOld = System.PrivateProfileString("qwcs.ini", "Document",
"QWREVOLD")
Security = System.PrivateProfileString("qwcs.ini", "Document", "QWSEC")
SerNo = System.PrivateProfileString("qwcs.ini", "Document", "QWSERIAL")
Stat = System.PrivateProfileString("qwcs.ini", "Document", "QWSTAT")
StatNum = System.PrivateProfileString("qwcs.ini", "Document", "QWSTATNUM")
Title = System.PrivateProfileString("qwcs.ini", "Document", "QWTITLE")
UserID = System.PrivateProfileString("qwcs.ini", "Document", "QWUSERID")
UserName = System.PrivateProfileString("qwcs.ini", "Document", "QWUSER")

'Section3 - Options to disable based on UserId
'This section enables all the options based on specified UserID
If UserID = "admin" Or UserID = "id1" Or UserID = "id2" Then

On Error Resume Next
CustomizationContext = ActiveDocument
CommandBars("Standard").Controls("Save").Enabled = True 'Enables the Save
option
CommandBars("Standard").Controls("Print").Enabled = True 'Enables The
Print
option
CommandBars("Standard").Controls("Print Preview").Enabled = True 'Enables
The Print Preview option
CommandBars("Standard").Controls("Cut").Enabled = True 'Enables The Cut
option
CommandBars("Standard").Controls("Copy").Enabled = True 'Enables The Copy
option
CommandBars("File").Controls("Save").Enabled = True 'Enables the Save
option
CommandBars("File").Controls("Save As...").Enabled = True 'Enables the
Save
As option
CommandBars("File").Controls("Save As HTML...").Enabled = True 'Enables
the
Save As HTML option
CommandBars("File").Controls("Print...").Enabled = True 'Enables the Print
option
CommandBars("File").Controls("Print Preview").Enabled = True 'Enables the
Print Preview option
CommandBars("Edit").Controls("Cut").Enabled = True 'Enables the Cut option
CommandBars("Edit").Controls("Copy").Enabled = True 'Enables the Copy
option
CommandBars("Tools").Controls("Customize...").Enabled = True 'Enables the
Customise option
KeyBindings.Add KeyCode:=wdKeyF12, KeyCategory:=wdKeyCategoryCommand,
Command:="FilePrint" 'Enables the F12 keyboard shortcut for printing
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeyP),
KeyCategory:=wdKeyCategoryCommand, Command:="FilePrint" 'Enables the
Ctrl+P
keyboard shortcut for printing
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeyS),
KeyCategory:=wdKeyCategoryCommand, Command:="FileSave" 'Enables the Ctrl+S
keyboard shortcut for saving
GoTo InsertInfo

'This section disables all the options based on specified UserID
Else
On Error Resume Next
CustomizationContext = ActiveDocument
CommandBars("Standard").Controls("Save").Enabled = False 'Disables the
Save
option
CommandBars("Standard").Controls("Print").Enabled = False 'Disables The
Print option
CommandBars("Standard").Controls("Print Preview").Enabled = False
'Disables
The Print Preview option
CommandBars("Standard").Controls("Cut").Enabled = False 'Disables The Cut
option
CommandBars("Standard").Controls("Copy").Enabled = False 'Disables The
Copy
option
CommandBars("File").Controls("Save").Enabled = False 'Disables the Save
option
CommandBars("File").Controls("Save As...").Enabled = False 'Disables the
Save As option
CommandBars("File").Controls("Save As HTML...").Enabled = False 'Disables
the Save As HTML option
CommandBars("File").Controls("Print...").Enabled = False 'Disables the
Print
option
CommandBars("File").Controls("Print Preview").Enabled = False 'Disables
the
Print Preview option
CommandBars("Edit").Controls("Cut").Enabled = False 'Disables the Cut
option
CommandBars("Edit").Controls("Copy").Enabled = False 'Disables the Copy
option
CommandBars("Tools").Controls("Customize...").Enabled = False 'Disables
the
Customise option
FindKey(KeyCode:=wdKeyF12).Disable 'Enables the F12 keyboard shortcut for
printing
FindKey(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyS)).Disable 'Disables the
Ctrl+P keyboard shortcut for printing
FindKey(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyP)).Disable 'Disables the
Ctrl+S keyboard shortcut for saving
FindKey(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyC)).Disable 'Disables the
Ctrl+S keyboard shortcut for Copy
FindKey(KeyCode:=BuildKeyCode(wdKeyControl, wdKeyX)).Disable 'Disables the
Ctrl+S keyboard shortcut for Cut
GoTo InsertInfo
End If

'Section4 - Determine the Absolute Document Status.

InsertInfo:
Select Case StatNum
Case "0"
Status = "New Draft "
Case "1"
Status = "New Draft, Ready for Approval "
Case "2"
Status = "New Draft, Undergoing Approval "
Case "3"
Status = "New Draft, Awaiting Issue "
Case "4"
Status = "Issued "
Case "5"
Status = "Issued, New Draft Exists "
Case "6"
Status = "Issued, New Draft Ready for Approval "
Case "7"
Status = "Issued, New Draft Undergoing Approval"
Case "8"
Status = "Issued, New Draft Awaiting Issue "
Case "9"
Status = "Obsolete "
Case "10"
Status = "Superseded "
Case "11"
Status = "Awaiting Withdrawal "
Case Else
Status = "Unknown "
End Select

'Section5 - Determine if you are viewing the ISSUED or DRAFT

Select Case Issued
Case "10"
Issued = "You are viewing the ISSUED version"
Case "11"
Issued = "You are viewing the DRAFT version"
Case "20"
Issued = "You are viewing the ISSUED version"
Case "21"
Issued = "You are viewing the DRAFT version"
End Select

'Section6 - This section creates the header, clears it then inserts all
the QWCS.INI Document info into it

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Or
ActiveWindow.ActivePane.View.Type _
= wdMasterView Then
ActiveWindow.ActivePane.View.Type = wdPageView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.WholeStory
Selection.Delete
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 8
Selection.Font.Underline = False
Selection.TypeText Text:="Last Approver: " + Approver + Chr(9) + Chr(9)
+ "Date of Approval: " + ApprovalDate
Selection.TypeParagraph
Selection.TypeText Text:="Document Author: " + Author + Chr$(9) +
Chr(9)
+ "Category: " + Category
Selection.TypeParagraph
Selection.TypeText Text:="CRQ Number: " + CRQNo + Chr(9) + Chr(9) +
"Date Created: " + DateCreate
Selection.TypeParagraph
Selection.TypeText Text:="Database: " + Database + Chr(9) + Chr(9) +
"Date Issued: " + DateIssued
Selection.TypeParagraph
Selection.TypeText Text:="Date Modified: " + DateCreate + Chr(9) +
Chr(9) + "Department: " + Dept
Selection.TypeParagraph
Selection.TypeText Text:="Document Owner: " + DocOwner + Chr(9) +
Chr(9)
+ "Path: " + DocPath
Selection.TypeParagraph
Selection.TypeText Text:="Reference: " + DocRef + Chr(9) + Chr(9) +
"Type: " + DocType
Selection.TypeParagraph
Selection.TypeText Text:="Edit Mode: " + Edit + Chr(9) + Chr(9) +
"Editor: " + Editor
Selection.TypeParagraph
Selection.TypeText Text:="New Document?: " + NewDoc + Chr(9) + Chr(9) +
"Version Viewed : " + Issued
Selection.TypeParagraph
Selection.TypeText Text:="Revision Number: " + Revision + Chr(9) +
Chr(9) + "Previous Revision: " + RevisionOld
Selection.TypeParagraph
Selection.TypeText Text:="Security: " + Security + Chr(9) + Chr(9) +
"serial Number: " + SerNo
Selection.TypeParagraph
Selection.TypeText Text:="Status: " + Stat + Chr(9) + Chr(9) + "Full
Status: " + Status
Selection.TypeParagraph
Selection.TypeText Text:="Document Title: " + Title + Chr(9) + Chr(9) +
"ID of User Viewing: " + UserID
Selection.TypeParagraph
Selection.TypeText Text:="Name of User Viewing: " + UserName
Selection.TypeParagraph

'Section7 This section clears then inserts the Footer information

If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
Selection.WholeStory
Selection.Delete
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 8
Selection.Font.Underline = False
Selection.TypeText Text:="Date Printed: " + Date$ + Chr(9) + Chr(9) +
"Page: "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:=
_
"NUMPAGES "
Selection.TypeParagraph
Selection.TypeText Text:="This Document is controlled using Workbench
Professional"
Selection.TypeParagraph


'Section8 This Section moves the focus back to the main Document,
clears
it and and inserts the title

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.MoveUp
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Font.Name = "Arial Narrow"
Selection.Font.Size = 14
Selection.Font.Bold = True
Selection.Font.Underline = True
Selection.TypeText Text:=Title
Selection.Font.Bold = False
Selection.Font.Underline = False
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = 10

'Section9 Inserts an 'Uncontrolled when printed' watermark

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Or
ActiveWindow.ActivePane.View.Type _
= wdMasterView Then
ActiveWindow.ActivePane.View.Type = wdPageView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
ActiveWindow.ActivePane.View.ShowMainTextLayer = Not ActiveWindow. _
ActivePane.View.ShowMainTextLayer
Selection.HeaderFooter.Shapes.AddTextbox(msoTextOrientationHorizontal,
_
100.8, 295.2, 410.4, 86.4).Select
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.TextFrame.TextRange.Select
Selection.Collapse
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 32
Selection.Font.Underline = False
Selection.Font.ColorIndex = wdGray25
Selection.TypeText Text:="UNCONTROLLED WHEN PRINTED"
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub
Click to expand...
 
B

Bill Bowes

Hi Charles

Many thanks for you help.

I will try the suggestion about using ranges, I am not an expert however!!

A bit of background:- to comply with strict regulatory document control
legislation, the documents themselves (with the body text) are held in a
secure central database on a server, and are only made available to view.
Once the document has been "issued" it is locked in the database and can not
be altered.
If someone needs to view it, a copy is extracted from the database and sent
to the local machine as a temp document.
The metadata in the header and footer would show what was there as the
document was last edited (draft awaiting approval), wheras we need it to show
"issued" at next version, hence the dynamic macro. (The document is stored
without this metadata, which is populated by the macro when the document is
opened).

The problem is that the macro only partially runs in that it misses out the
lines where opening the header and footer is required. Everything else
happens as expected, it reads the data from the ini file, but instead of
putting it in the header, it puts it in the body text of the document.

Sorry this is long winded, but we have to conform to regulatory requirements
about documents and document "metadata", and this seems to be the only way
round it.

Bill
 
C

Charles Kenyon

The reason I suggested using the range rather than opening the header/footer
is that it is much more reliable. This is one (of many) problems with using
recorded macros as the basis for coding; you can't record a macro to change
a range. Another advantage is that directly manipulating the range is
quicker than opening the header/footer on screen (even with screen updating
turned off).

I am very much a novice at this stuff myself. Take a look at
http://word.mvps.org/FAQs/MacrosVBA/index.htm and the pages there on ranges
and selections for more help.

Note that for an AutoOpen macro to work, it has to get past the user's macro
security.
--
Charles Kenyon

Word New User FAQ & Web Directory: http://addbalance.com/word

Intermediate User's Guide to Microsoft Word (supplemented version of
Microsoft's Legal Users' Guide) http://addbalance.com/usersguide


--------- --------- --------- --------- --------- ---------
This message is posted to a newsgroup. Please post replies
and questions to the newsgroup so that others can learn
from my ignorance and your wisdom.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Making a macro only work on certain files 2
Disable AutoOpen macro after saving document 3
Need help modifying code 0
macroed table - borders missing 4
Macro to count words in a section, excluding footnotes and end notes 1
Word Macro for multiple searches, incl. in footnotes 2
macro 2 issues 0
Worked in 2003, not in 2007 6

Top