D
Deejay
I've asked several questions on creating a letterhead/fax toggle with 3 states:
1. Graphic visible and a bookmarked line reading BY FAX ONLY with the fax
number
2. Graphics hidden and a bookmarked line reading FIRST BY FAX with the fax
number
3. Graphics hidden and the bookmarked line hidden.
With your help I've written the code below which works and for that thanks.
But several other programs hate the macro and it often crashes on me just
when I open Work. So can I ask: Where have I gone wrong? Many many thanks.
It will be used in 2007 but in compatability mode.
'Option Explicit
'Sub ToggleLetterhead()
'
' ToggleLetterhead Macro
'
'
Dim boolFax As Boolean
Dim ByFaxHidden As Boolean
Dim aShape As Shape
Dim oBMs As Bookmarks
Dim rgeByFax As Range
Dim rgeFaxNumber As Word.Range
Const strByFax As String = "ByFax"
Const strFaxNumber As String = "FaxNumber"
Set oBMs = ActiveDocument.Bookmarks
If Not oBMs.Exists(strByFax) Then
MsgBox "Enter FIRST BY FAX:/BY FAX ONLY: in document, and bookmark it
'ByFax'", vbOKOnly + vbExclamation, "ENTER FAX INFORMATION"
Exit Sub
End If
Set rgeByFax = ActiveDocument.Bookmarks(strByFax).Range
'Setting Bookmarks
If oBMs.Exists(strFaxNumber) Then
Set rgeFaxNumber = ActiveDocument.Bookmarks(strFaxNumber).Range
Else
oBMs(strByFax).Range.Select
Set rgeFaxNumber = ActiveDocument.Bookmarks("\line").Range
rgeFaxNumber.Start = oBMs(strByFax).End + 0
rgeFaxNumber.End = rgeFaxNumber.End - 1
oBMs.Add strFaxNumber, rgeFaxNumber
End If
'Check if in First By Fax mode or plain letterhead
On Error GoTo ErrorHandler
ByFaxHidden = ActiveDocument.Bookmarks(strByFax).Range.Font.Hidden
If rgeByFax.Text = "FIRST BY FAX: " And Not ByFaxHidden Then 'in First
By Fax mode so toggle to plain letterhead
rgeByFax.Font.Hidden = True
rgeFaxNumber.Font.Hidden = True
Exit Sub
Else 'Either toggle to fax or to First By Fax
With ActiveDocument
' Check current status - it's in fax format if graphics are visible
boolFax =
..Sections(1).Headers(wdHeaderFooterFirstPage).Shapes(1).Visible
' Show/Hide the graphics
With .Sections(1)
For Each aShape In .Headers(wdHeaderFooterFirstPage).Shapes
aShape.Visible = Not boolFax
Next aShape
End With
' Toggle style information and Header space
If boolFax Then ' We are in a fax and toggling to letter
.Styles("LetterRefs").ParagraphFormat.SpaceBefore = 0
.Styles("LetterDate").ParagraphFormat.SpaceAfter = 38 + 17
'Change it to First By Fax
rgeByFax.Text = "FIRST BY FAX: "
ActiveDocument.Bookmarks.Add strByFax, rgeByFax
Else ' Set spacing for Fax
.Styles("LetterRefs").ParagraphFormat.SpaceBefore = 17
.Styles("LetterDate").ParagraphFormat.SpaceBefore = 0
.Styles("LetterDate").ParagraphFormat.SpaceAfter = 38
'Toggle bookmarks to Fax Only
rgeByFax.Text = "BY FAX ONLY: "
ActiveDocument.Bookmarks.Add strByFax, rgeByFax
rgeByFax.Font.Hidden = False
rgeFaxNumber.Font.Hidden = False
End If
End With
Exit Sub
' Trap attempts to use on damaged or old version document
ErrorHandler:
MsgBox "Cannot toggle letterhead for this document format", vbOKOnly +
vbExclamation, "Show/Hide Letterhead"
End If
End Sub
1. Graphic visible and a bookmarked line reading BY FAX ONLY with the fax
number
2. Graphics hidden and a bookmarked line reading FIRST BY FAX with the fax
number
3. Graphics hidden and the bookmarked line hidden.
With your help I've written the code below which works and for that thanks.
But several other programs hate the macro and it often crashes on me just
when I open Work. So can I ask: Where have I gone wrong? Many many thanks.
It will be used in 2007 but in compatability mode.
'Option Explicit
'Sub ToggleLetterhead()
'
' ToggleLetterhead Macro
'
'
Dim boolFax As Boolean
Dim ByFaxHidden As Boolean
Dim aShape As Shape
Dim oBMs As Bookmarks
Dim rgeByFax As Range
Dim rgeFaxNumber As Word.Range
Const strByFax As String = "ByFax"
Const strFaxNumber As String = "FaxNumber"
Set oBMs = ActiveDocument.Bookmarks
If Not oBMs.Exists(strByFax) Then
MsgBox "Enter FIRST BY FAX:/BY FAX ONLY: in document, and bookmark it
'ByFax'", vbOKOnly + vbExclamation, "ENTER FAX INFORMATION"
Exit Sub
End If
Set rgeByFax = ActiveDocument.Bookmarks(strByFax).Range
'Setting Bookmarks
If oBMs.Exists(strFaxNumber) Then
Set rgeFaxNumber = ActiveDocument.Bookmarks(strFaxNumber).Range
Else
oBMs(strByFax).Range.Select
Set rgeFaxNumber = ActiveDocument.Bookmarks("\line").Range
rgeFaxNumber.Start = oBMs(strByFax).End + 0
rgeFaxNumber.End = rgeFaxNumber.End - 1
oBMs.Add strFaxNumber, rgeFaxNumber
End If
'Check if in First By Fax mode or plain letterhead
On Error GoTo ErrorHandler
ByFaxHidden = ActiveDocument.Bookmarks(strByFax).Range.Font.Hidden
If rgeByFax.Text = "FIRST BY FAX: " And Not ByFaxHidden Then 'in First
By Fax mode so toggle to plain letterhead
rgeByFax.Font.Hidden = True
rgeFaxNumber.Font.Hidden = True
Exit Sub
Else 'Either toggle to fax or to First By Fax
With ActiveDocument
' Check current status - it's in fax format if graphics are visible
boolFax =
..Sections(1).Headers(wdHeaderFooterFirstPage).Shapes(1).Visible
' Show/Hide the graphics
With .Sections(1)
For Each aShape In .Headers(wdHeaderFooterFirstPage).Shapes
aShape.Visible = Not boolFax
Next aShape
End With
' Toggle style information and Header space
If boolFax Then ' We are in a fax and toggling to letter
.Styles("LetterRefs").ParagraphFormat.SpaceBefore = 0
.Styles("LetterDate").ParagraphFormat.SpaceAfter = 38 + 17
'Change it to First By Fax
rgeByFax.Text = "FIRST BY FAX: "
ActiveDocument.Bookmarks.Add strByFax, rgeByFax
Else ' Set spacing for Fax
.Styles("LetterRefs").ParagraphFormat.SpaceBefore = 17
.Styles("LetterDate").ParagraphFormat.SpaceBefore = 0
.Styles("LetterDate").ParagraphFormat.SpaceAfter = 38
'Toggle bookmarks to Fax Only
rgeByFax.Text = "BY FAX ONLY: "
ActiveDocument.Bookmarks.Add strByFax, rgeByFax
rgeByFax.Font.Hidden = False
rgeFaxNumber.Font.Hidden = False
End If
End With
Exit Sub
' Trap attempts to use on damaged or old version document
ErrorHandler:
MsgBox "Cannot toggle letterhead for this document format", vbOKOnly +
vbExclamation, "Show/Hide Letterhead"
End If
End Sub