J
jec
HNY all,
This macro used to Work in 2003 but now does not work in either 03 or 07 (if
you have 2010 please feel free to test it in there too). I have marked rows
so far throwing errors with '*****. I am sure more rows will throw errors.
Option Explicit
Const varName As String = "BookmarkCounter"
Const varDuplicateName As String _
= "DuplicateBookmarkCounter"
Sub CreateBookmark()
' TEST
'
'Variable declaration
Dim rng As Word.Range
Dim BookmarkName As String
Dim var As Word.Variable
Dim varName As String '**** Added this line - Otherwise error
'Check whether the document variable that stores
'a counter for bookmarks without content exists
If varExists(ActiveDocument, varName) = False Then
'If not, create it and assign it the value 1
ActiveDocument.Variables.Add _
Name:=varName, Value:="1" '****Method 'Add' of
object 'Variables' failed HELP PLEASE
End If
Set var = ActiveDocument.Variables(varName)
Set rng = Selection.Range
If Selection.Type = wdSelectionIP Then
'The user didn't select any text; a bookmark without
'content will be inserted with
'an incremented name bm#
'Calculate that name
BookmarkName = "bm" & var.Value
var.Value = CStr(CLng(var.Value) + 1)
'Alternately, a prompt can be displayed
'to ask the user for the name
'Uncomment the next two lines to use that method
'BookmarkName = InputBox( _
'No text is selected. Type in a bookmark name.")
Else
'Get the bookmark name based on the selected text
BookmarkName = ProcessBookmarkName(rng.Text)
End If
'Check if the bookmark name already exists;
'if it does it will be incremented with a counter
BookmarkName = "bm" & CheckIfDuplicateName( _
ActiveDocument, BookmarkName)
'Insert the bookmark
ActiveDocument.Bookmarks.Add _
Name:=BookmarkName, Range:=rng
End Sub
Function ProcessBookmarkName(s As String) As String
'Variable declaration
Dim i As Long
'Maximum length of a bookmark name is 40 characters
'Because txt will be added to the beginning
'therefore cut off at 37
If Len(s) > 37 Then s = Left(s, 37)
'Replace all spaces with underline characters
s = Replace(s, " ", "_")
'Remove any numbers at the beginning
'Repeats a block of statements while a condition is True
'or until a condition becomes True.
Do While IsNumeric(Left(s, 1)) = True
s = Mid(s, 2)
Debug.Print s
Loop
'Remove invalid characters
'(following list is not comprehensive)
For i = 1 To Len(s)
'Repeats a block of statements while a condition is True
'or until a condition becomes True.
Select Case Mid(s, i, 1)
Case "§", "°", "+", "¦", "@", Chr$(34), "*", _
"#", "%", "&", "", "/", "|", "(", "¢", ")", _
"=", "?", "´", "^", "`", "~", "[", "]", _
"¨", "!", "{", "}", "$", "£", "<", ">", "<", _
".", ",", ":", ";", "-"
s = Left(s, i - 1) & Mid(s, i + 1)
Case Else
'Otherwise, do nothing
End Select
Next i
ProcessBookmarkName = s
End Function
Function CheckIfDuplicateName(doc As Word.Document, _
BookmarkName As String) As String
'Variable declaration
Dim var As Word.Variable
If varExists(doc, varDuplicateName) = False Then
ActiveDocument.Variables.Add _
Name:=varDuplicateName, Value:="1"
End If
Set var = ActiveDocument.Variables(varDuplicateName)
If doc.Bookmarks.Exists(BookmarkName) Then
'Calculate incremented name
BookmarkName = Left(BookmarkName, _
Len(BookmarkName) - Len(var.Value)) & var.Value
var.Value = CStr(CLng(var.Value) + 1)
End If
CheckIfDuplicateName = BookmarkName
End Function
Function varExists(doc As Word.Document, _
s As String) As Boolean
'Variable declaration
Dim var As Word.Variable
varExists = False
'Loop through the list of document variables
'ând check whether it already exists by
'comparing the name
'The For Each loop takes each member of an identified group
'and perfoms the actions between the For and Next lines.
For Each var In doc.Variables
If var.Name = s Then
varExists = True
Exit For
End If
Next var
End Function
This macro used to Work in 2003 but now does not work in either 03 or 07 (if
you have 2010 please feel free to test it in there too). I have marked rows
so far throwing errors with '*****. I am sure more rows will throw errors.
Option Explicit
Const varName As String = "BookmarkCounter"
Const varDuplicateName As String _
= "DuplicateBookmarkCounter"
Sub CreateBookmark()
' TEST
'
'Variable declaration
Dim rng As Word.Range
Dim BookmarkName As String
Dim var As Word.Variable
Dim varName As String '**** Added this line - Otherwise error
'Check whether the document variable that stores
'a counter for bookmarks without content exists
If varExists(ActiveDocument, varName) = False Then
'If not, create it and assign it the value 1
ActiveDocument.Variables.Add _
Name:=varName, Value:="1" '****Method 'Add' of
object 'Variables' failed HELP PLEASE
End If
Set var = ActiveDocument.Variables(varName)
Set rng = Selection.Range
If Selection.Type = wdSelectionIP Then
'The user didn't select any text; a bookmark without
'content will be inserted with
'an incremented name bm#
'Calculate that name
BookmarkName = "bm" & var.Value
var.Value = CStr(CLng(var.Value) + 1)
'Alternately, a prompt can be displayed
'to ask the user for the name
'Uncomment the next two lines to use that method
'BookmarkName = InputBox( _
'No text is selected. Type in a bookmark name.")
Else
'Get the bookmark name based on the selected text
BookmarkName = ProcessBookmarkName(rng.Text)
End If
'Check if the bookmark name already exists;
'if it does it will be incremented with a counter
BookmarkName = "bm" & CheckIfDuplicateName( _
ActiveDocument, BookmarkName)
'Insert the bookmark
ActiveDocument.Bookmarks.Add _
Name:=BookmarkName, Range:=rng
End Sub
Function ProcessBookmarkName(s As String) As String
'Variable declaration
Dim i As Long
'Maximum length of a bookmark name is 40 characters
'Because txt will be added to the beginning
'therefore cut off at 37
If Len(s) > 37 Then s = Left(s, 37)
'Replace all spaces with underline characters
s = Replace(s, " ", "_")
'Remove any numbers at the beginning
'Repeats a block of statements while a condition is True
'or until a condition becomes True.
Do While IsNumeric(Left(s, 1)) = True
s = Mid(s, 2)
Debug.Print s
Loop
'Remove invalid characters
'(following list is not comprehensive)
For i = 1 To Len(s)
'Repeats a block of statements while a condition is True
'or until a condition becomes True.
Select Case Mid(s, i, 1)
Case "§", "°", "+", "¦", "@", Chr$(34), "*", _
"#", "%", "&", "", "/", "|", "(", "¢", ")", _
"=", "?", "´", "^", "`", "~", "[", "]", _
"¨", "!", "{", "}", "$", "£", "<", ">", "<", _
".", ",", ":", ";", "-"
s = Left(s, i - 1) & Mid(s, i + 1)
Case Else
'Otherwise, do nothing
End Select
Next i
ProcessBookmarkName = s
End Function
Function CheckIfDuplicateName(doc As Word.Document, _
BookmarkName As String) As String
'Variable declaration
Dim var As Word.Variable
If varExists(doc, varDuplicateName) = False Then
ActiveDocument.Variables.Add _
Name:=varDuplicateName, Value:="1"
End If
Set var = ActiveDocument.Variables(varDuplicateName)
If doc.Bookmarks.Exists(BookmarkName) Then
'Calculate incremented name
BookmarkName = Left(BookmarkName, _
Len(BookmarkName) - Len(var.Value)) & var.Value
var.Value = CStr(CLng(var.Value) + 1)
End If
CheckIfDuplicateName = BookmarkName
End Function
Function varExists(doc As Word.Document, _
s As String) As Boolean
'Variable declaration
Dim var As Word.Variable
varExists = False
'Loop through the list of document variables
'ând check whether it already exists by
'comparing the name
'The For Each loop takes each member of an identified group
'and perfoms the actions between the For and Next lines.
For Each var In doc.Variables
If var.Name = s Then
varExists = True
Exit For
End If
Next var
End Function