Help please - Type Mismatch error when selecting a customized footerfrom list

[bobkapur]

I wrote a macro that allows a user to select from a list of
alternative footers upon opening a document (see below). I want to
know if there is a way to tweak this so that the system will not
accept an entry other than the available options, or that it will at
least not result in a Debug error. RIght now, the coding accepts
numeric answers other than 1 through 5. But if you enter an alpha
character or other symbol, it kicks to a type mismatch error. Any way
to either suppress that error, or force them to re-select?

Script I have for the actual selection is as follows:


Private Sub Document_New()
Application.ScreenUpdating = False
Dim Rng As Range, Str As String, Fld As Field, i As Long
i = CLng(InputBox("Select Document Classification:" & vbCr &
"[1]Option 1 [2]
Option 2 [3] Option 3 [4] Option 4 [5] Option 5"))
If i < 0 Or i > 5 Then Exit Sub
With ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary)
Set Rng = .Range.Characters.First
Rng.Collapse wdCollapseStart
For Each Fld In .Range.Fields
With Fld
If .Type = wdFieldQuote Then
Set Rng = Fld.Result
..Delete
Exit For
End If
End With
Next
Select Case i
Case 1
Str = "Option 1"
Case 2
Str = "Option 2"
Case 3
Str = "Option 3"
Case 4
Str = "Option 4"
Case 5
Str = "Option 5"
End Select
Set Fld = ActiveDocument.Fields.Add(Range:=Rng, Type:=wdFieldQuote, _
Text:="""" & Str & """", PreserveFormatting:=False)
End With
Set Fld = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
With Selection.ParagraphFormat
..Borders(wdBorderLeft).LineStyle = wdLineStyleNone
..Borders(wdBorderRight).LineStyle = wdLineStyleNone
With .Borders(wdBorderTop)
..LineStyle = wdLineStyleSingle
..LineWidth = wdLineWidth050pt
..Color = wdColorAutomatic
End With
..Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Borders
..DistanceFromTop = 1
..DistanceFromLeft = 4
..DistanceFromBottom = 1
..DistanceFromRight = 4
..Shadow = False
End With
End With
With Options
..DefaultBorderLineStyle = wdLineStyleSingle
..DefaultBorderLineWidth = wdLineWidth050pt
..DefaultBorderColor = wdColorAutomatic
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

 

[H. Druss]

I wrote a macro that allows a user to select from a list of
alternative footers upon opening a document (see below). I want to
know if there is a way to tweak this so that the system will not
accept an entry other than the available options, or that it will at
least not result in a Debug error. RIght now, the coding accepts
numeric answers other than 1 through 5. But if you enter an alpha
character or other symbol, it kicks to a type mismatch error. Any way
to either suppress that error, or force them to re-select?

Hi
This should do what you want.
Harold
================================================
Private Sub Document_New()
Application.ScreenUpdating = False
Dim Rng As Range, Str As String, Fld As Field, i As String

i = InputBox("Select Document Classification:" & vbCrLf & vbCrLf & "[1]
Option 1" & vbCrLf & "[2] Option 2" & vbCrLf & "[3] Option 3" & vbCrLf &
"[4] Option 4" & vbCrLf & "[5] Option 5" & vbCrLf & vbCrLf & "Please enter a
digit (1-5)")

' did user press cancel?
If i = "" Then
MsgBox "User cancelled", vbCritical
Exit Sub
End If

' is the entry a digit?
If Not IsNumeric(i) Then
MsgBox "Entry must be numeric (1-5)"
Exit Sub
End If

' is the value between 1 and 5
If CLng(i) < 0 Or CLng(i) > 5 Then
MsgBox "Valid numbers are: 1, 2, 3, 4 and 5"
Exit Sub
End If

With ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary)
Set Rng = .Range.Characters.First
Rng.Collapse wdCollapseStart
For Each Fld In .Range.Fields
With Fld
If .Type = wdFieldQuote Then
Set Rng = Fld.Result
.Delete
Exit For
End If
End With
Next
Select Case i
Case 1
Str = "Option 1"
Case 2
Str = "Option 2"
Case 3
Str = "Option 3"
Case 4
Str = "Option 4"
Case 5
Str = "Option 5"
End Select

Set Fld = ActiveDocument.Fields.Add(Range:=Rng, Type:=wdFieldQuote, _
Text:="""" & Str & """", PreserveFormatting:=False)
End With

Set Fld = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If

If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If

With Selection.ParagraphFormat
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = False
End With
End With

With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub
========================================================