VB Macro Library useful for RPE

Seeing that a lot of RPE’s users have a minimal or none VB knowledge, I’ve decided to create a small library with some of the most used macros in RPE. We thought that will be a good idea to have all the VB Macros for RPE stored in a single place. Not all the macros are not the property of GEBS Reporting
Each macro will have associated a short description and below the pure VB code. The macros list will be continuously improved, and each week will try to update this list with new macros or with requested macros.

1. Updates ToC

This macro will update all the Table of Contents from the active document

Sub updateTOCs()
    On Error Resume Next
    Dim toc As TableOfContents
    For Each toc In ActiveDocument.TablesOfContents
        toc.Update
        toc.UpdatePageNumbers
    Next
End Sub

2. Updates ToF

This macro will update all the Table of Figures from the active document

Sub updateTOFs()
    On Error Resume Next
    Dim tof As TableOfFigures
    For Each tof In ActiveDocument.TablesOfFigures
        tof.Update
        tof.UpdatePageNumbers
    Next
End Sub

3. Updates ToT

This macro will update all the Table of Tables from the active document

Sub updateTOTs()
    On Error Resume Next
    Dim tot As TableOfTables
    For Each tot In ActiveDocument.TablesOfTables
        tot.Update
        tot.UpdatePageNumbers
    Next
End Sub

4. Update all fields

This VB macro will Update all the fields in the active document

Public Sub updateFields()
    ActiveDocument.Fields.Update
End Sub

5. Extends content of OLE’s

This macro will extends the content of WORD OLE object in a document

Public Sub extendOLE()
Dim doc As Document
Set doc = ActiveDocument
Dim iShape As InlineShape
nFld = doc.InlineShapes.Count
For i = nFld To 1 Step -1
    Set iShape = doc.InlineShapes.Item(i)
    If iShape.Type = wdInlineShapeEmbeddedOLEObject Then
        iShape.Select
        Selection.InlineShapes(1).OLEFormat.DoVerb VerbIndex:=1
        Selection.WholeStory
        Selection.Cut
        ActiveDocument.Close
        Selection.PasteAndFormat (wdPasteDefault)
    End If
Next i
End Sub

6. Embed OLE objects and Unlink

The macro will search for embedded OLE objects, and for the Word type OLE’s, will copy their document content and insert it in the place of the OLE. After this, all fields within the main document are unlinked.

Sub includeOLEContent()

    Dim index As Long
    Dim wrdActDoc As Document
    Dim str As String
    Dim oDoc As Word.Document
    Dim oDocObj As Object
    Dim oDocInlineShape As Word.InlineShape
    Dim content As String
    Dim rng As Word.Range
    Dim oFld As Word.field
    Set wrdActDoc = ActiveDocument

    For index = 1 To wrdActDoc.InlineShapes.Count
        If wrdActDoc.InlineShapes(index).Type = wdInlineShapeEmbeddedOLEObject Then
               str = wrdActDoc.InlineShapes(index).OLEFormat.ClassType
               
                If InStr(1, str, "Word", 0) <> 0 Then
                    Set oDocInlineShape = wrdActDoc.InlineShapes(index)
                    oDocInlineShape.OLEFormat.Edit
                    Set oDoc = oDocInlineShape.OLEFormat.Object
                    oDoc.Range.Copy
                    oDocInlineShape.Range.Paste
                End If
        End If
    Next index
    
   For Each rng In wrdActDoc.StoryRanges
        Do
            For Each oFld In rng.Fields
                oFld.Unlink
            Next
            Set rng = rng.NextStoryRange
        Loop Until rng Is Nothing
   Next

End Sub

7.Shade row

Shade every odd row within a table

Sub FindTables()
  Dim iResponse As Integer
  Dim i As Integer
  Dim tTable As Table
  'If any tables exist, loop through each table in collection.
  For Each tTable In ActiveDocument.Tables
    With tTable
    'Shade columun header(s)
    .Rows(1).Shading.BackgroundPatternColor = wdColorGray20
       For i = 2 To .Rows.Count
         With .Rows(i).Shading
         'Shade odd row(s)
         If i Mod 2 = 1 Then
            .BackgroundPatternColor = wdColorGray05
        Else
            .BackgroundPatternColor = wdColorAutomatic
        End If
        End With
     Next
  End With
  Next
End Sub