VBA Snippets
Bookmarks_DeleteAll
Public Sub Bookmark_DeleteAll()
Dim ibookmarknumber As Integer
On Error GoTo AnError
For ibookmarknumber = 1 To ActiveDocument.Bookmarks.Count
ActiveDocuments.Bookmarks(1).Delete
Next ibookmarknumber
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("Bookmark_DeleteAll", msMODULENAME, 1, _
"remove all the bookmarks from the active document)
End Sub
BreakAll
Public Sub Links_BreakAll(ByVal bShapes As Boolean, _
ByVal bFields As Boolean, _
ByVal bFieldsDDE As Boolean)
Dim objShape As Shape
Dim objField As Field
On Error GoTo AnError
If bShapes = True Then
For Each shapeLoop In ActiveDocument.Shapes
With shapeLoop
'.Select
If .Type = MsoShapeType.msoLinkedOLEObject Then
.LinkFormat.Update
.LinkFormat.BreakLink
End If
End With
Next shapeLoop
End If
If bFields = True Then
For Each objField In ActiveDocument.Fields
Debug.Print objField.Code.Text
If objField.Type = wdFieldDDEAuto Then
objField.Unlink
End If
'objField.LinkFormat.BreakLink
Next objField
End If
Exit Sub
AnError:
Call Error_Handle("Links_BreakAll", msMODULENAME, _
"")
End Sub
Delete
Deletes a bookmark from the active document.Public Sub Bookmark_Delete(ByVal sBookmarkName As String)
On Error GoTo AnError
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("Bookmark_Delete", msMODULENAME, 1, _
"delete the bookmark """ & sBookmarkName & """")
End Sub
Delete
Removes a particular field from the active document.Public Sub Field_Delete(sFieldName As String, _
sPropertyValue As String)
Const sPROCNAME As String = "Field_Delete"
On Error GoTo AnError
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle(msMODULENAME, sPROCNAME, 1,
"")
End Sub
GoTo
Goes to a particular bookmark in the current document.Public Sub Bookmark_GoTo(ByVal sBookmarkName As String)
On Error GoTo AnError
Application.GoTo Reference:=sBookMarkName
Selection.GoTo What:=wdGoToBookmark, Name:=sBookmarkName
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("Bookmark_GoTo", msMODULENAME, 1, _
"go to the bookmark """ & sBookmarkName & """")
End Sub
HyperlinkInsert
Inserts a hyperlink at the current location.Public Sub Doc_HyperlinkInsert()
On Error GoTo AnError
' ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
' SubAddress:="MyBookmark"
'to a bookmark in another document
' ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
' "C:\MyDoc.doc", SubAddress:=""
'to a web address
' ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
' "http://www.microsoft.com/office/", SubAddress:=""
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("Doc_HyperlinkInsert", msMODULENAME, 1, _
"insert a hyperlink to " & ">>>>>>>>>>>>>>" & " at the current position")
End Sub
Insert
Inserts a bookmark at the current position in the active document.Public Sub Bookmark_Insert(ByVal sBookmarkName As String)
On Error GoTo AnError
' With ActiveDocument.Bookmarks
' .Add Range:=Selection.Range, Name:=sBookMarkName
' .DefaultSorting = wdSortByName
' .ShowHidden = False
' End With
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("Bookmark_Insert", msMODULENAME, 1, _
"insert the bookmark """ & sBookmarkName & """ at the current position")
End Sub
Insert
Inserts a field at the current position in the active document.Public Sub Field_Insert(sText As String, _
sStyleName As String)
Const sPROCNAME As String = "Field_Insert"
On Error GoTo AnError
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
Text:=sText, _
Preserveformatting:=True
If gbDEBUG = False Then Exit Sub
AnError:
' Call Error_Handle(msMODULENAME, sPROCNAME, 1,
Call MsgBox( _
"insert the field")
End Sub
ParagraphSelect
Selects the paragraph that has the bookmark with the corresponding name at the front.Public Sub Bookmark_ParagraphSelect(ByVal sBookMarkName As String)
On Error Goto AnError
With Selection
.GoTo What:=wdGoToBookmark, Name:=sBookMarkName
.StartOf wdParagraph
.EndOf wdParagraph, wdExtend
End With
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("Bookmark_ParagraphSelect", msMODULENAME, 1, _
"select the paragragh bookmark """ & sBookMarkName & """")
End Sub
RemoveUnwantedChars
Removes all the unwanted characters that are not allowed to appear in bookmarks.Public Function Bookmark_RemoveUnwantedChars(ByVal sBookmarkName As String, _
Optional ByVal sReplaceChar as String = "_") _
As String
Dim sfinaltext As String
Dim icount As Integer
On Error Goto AnError
For icount = 1 To Len(sBookmarkName)
If Mid(sBookmarkName, icount, 1) = " " Or _
Mid(sBookmarkName, icount, 1) = "-" Then
sfinaltext = sfinaltext & "_"
Else
sfinaltext = sfinaltext & Mid(sBookmarkName, icount, 1)
End If
Next icount
Bookmark_RemoveUnwantedChars = sfinaltext
If gbDEBUG = False Then Exit Function
AnError:
Call Error_Handle("Bookmark_RemoveUnwantedChars", msMODULENAME, 1, _
"remove all the unwanted characters that cannot appear in bookmarks")
End Function
TextAdd
Public Sub Bookmark_TextAdd(ByVal bCancel As Boolean, _
ByVal sBookmarkName As String, _
ByVal sText As String, _
Optional ByVal bExtend As Boolean = False)
On Error GoTo AnError
If (bCancel = False) And Bookmark_GoTo(sBookmarkName) = True Then
If bExtend = True Then Selection.EndKey wdLine, wdExtend
Selection.TypeText Text:=sText
Else
bCancel = True
End If
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle("Bookmark_TextAdd", msMODULENAME, 1, _
"add the text" & vbcrlf & """" & sText & """" & _
"to the bookmark """ & sBookmarkName & """")
End Sub
Trim
Trims a field removing any leading or trailing spaces.Public Sub Field_Trim(sDisplayText As String, _
lFieldType As Long)
Const sPROCNAME As String = "Field_Trim"
Dim fldField As Field
On Error GoTo AnError
For Each fldField In ActiveDocument.Fields
If fldField.Type = lFieldType And _
InStr(1, fldField.Code, sDisplayText) > 0 Then
fldField.Code.Text = Trim(CStr(fldField.Code))
End If
Next fldField
If gbDEBUG = False Then Exit Sub
AnError:
Call Error_Handle(msMODULENAME, sPROCNAME, 1,
"trim the added field and remove the extra space")
End Sub
UpdateAll
Updates all the fields in the active document, including all sections, headers and footers.Public Sub Fields_UpdateAll()
Const sPROCNAME As String = "Fields_UpdateAll"
On Error GoTo AnError
Selection.WholeStory
Selection.Fields.Update
Call Section_FirstPageUpdate
Call Section_CurrentPageUpdate
Call Section_EvenPageUpdate
Call Section_PrimaryPageUpdate
If gbDEBUG = False Then Exit Sub
AnError:
' Call Error_Handle(msMODULENAME, sPROCNAME, 1,
Call MsgBox( _
"update ALL the fields in the active document")
End Sub
© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited Top